program EOEC_MalaDir;

{$B-}

uses
    Crt, Dos, Ernst, Crc;

var
    Buffer        : string;       {Buffer tempor rio para leitura de arquivos}
    C             : byte;         {Contador tempor rio}
    F             : text;         {Arquivo Texto Tempor rio}
    Tempflag      : boolean;      {Flag boleano tempor rio}
    UserName      : string;
    UserFName     : string;
    UserEMail     : string;
    UserRegCode   : string;
    Users         : text;
    Main1, Main2, Maladir : text;
    TotalUsers    : byte;

(* ---------------------------------------------------------------------- *)
function ValToChar(Valor: LongInt): string;
begin
    ValToChar := Chr(Valor+65);
end;

(* ---------------------------------------------------------------------- *)
function TrimVal4(w : Word) : String;
         {Ajusta um n£mero para duas casas, colocando zero na frente, se
         necess rio.  Retorna o resultado numa string}

var
  s : String;

begin

    Str(w:0,s);
    if length(s) < 4 then s := '0' + s;
    if length(s) < 4 then s := '0' + s;
    if length(s) < 4 then s := '0' + s;
    if length(s) < 4 then s := '0' + s;
    TrimVal4 := s;

end;

(* ---------------------------------------------------------------------- *)
function CopyInt(Valor:longint; Pos1, Len:byte) : longint;
var Valor1, Valor2 : longint;

     function DezA(X:byte) : longint;
     begin
         DezA := round(exp(ln(10)*X));
     end;

begin

    valor1 := (Valor div DezA(Pos1-Len));
    valor2 := (Valor div DezA(Pos1))*(DezA(Len));

    CopyInt := Valor1 - Valor2;

end;

(* ---------------------------------------------------------------------- *)
function RegCode(UserName : string): string;
var UserCRC  : longint;
    RegCode1 : string[1];
    RegCode2 : string[4];
    RegCode3 : string[1];

begin

UserCRC := Abs(CRC32(Upper(UserName)));
RegCode1 := ValToChar(CopyInt(UserCRC,2,2) mod 25);
RegCode2 := TrimVal4(CopyInt(UserCRC,6,4));
RegCode3 := ValToChar(CopyInt(UserCRC,8,2) mod 25);

{ Composi‡„o do c¢digo de registro do usu rio de acordo com o CRC32:

               CRC32 = XXXXXXXXXX
                         À´ÀÄÂÙÀ´
                          ³  ³  ³
                          ³ÚÄÁ¿ÚÙ
  User Register Code =    @NNNN@

                   @ = chr(XX mod 25)
                NNNN = XXXX                     }


RegCode := RegCode1+RegCode2+RegCode3;

end;

(* ---------------------------------------------------------------------- *)
procedure Logo;
    (* Logo de programado por Ernesto Baschny *)

begin

    clrscr;
    HighVideo;
    writeln('EOEC Maladireta v1.0');
    LowVideo;
    writeln('(c) 1995 por Ernesto Baschny');
    writeln;
    writeln('C:\EOEC\MALAD1  arquivo com mala-direta Internet');
    writeln('C:\EOEC\MALAD2  arquivo com mala-direta para STI');
    writeln;

end; {Logo}

(* ---------------------------------------------------------------------- *)
procedure ErrorMsg(Errorlevel: Byte; Error1, Error2: String);
    (* Apresenta mensagem de erro e sai com errorlevel especificado *)

begin

     textcolor(lightred);
     writeln('ERRO: ',Error1);
     textcolor(lightgray);
     writeln;
     if Error2 <> '' then
        writeln('þ ',Error2);
     CursorOff;
     readkey;
     CursorOn;
     halt(Errorlevel);

end;

(* ---------------------------------------------------------------------- *)
procedure WriteMacroLine(var DestFile: Text; Line: String);
    (* Lˆ linha especificada e grava ela no arquivo DestFile, usando *)
    (* vari veis, se necess rio                                      *)

var TempLine : String;
    Macro    : String[10];
    I        : Byte;

begin

     TempLine := '';
     Macro := '';
     I := 1;

     while I <= Length(Line) do
     begin
          if Line[I] <> '@' then TempLine := TempLine + Line[I];
          if Line[I] = '@' then
          begin
               Tempflag := false;
               inc(I);

               while Tempflag = false do
               begin
                    if (Line[I] <> '@') and (Line[I] <> ' ') then Macro := Macro + Line[I];
                    if (Line[I] = '@') or (Line[I] = ' ') then Tempflag := true;
                    inc(I);
               end;

               dec(I);
               Macro := Upper(Macro);

               if Macro = 'NOME' then TempLine := TempLine + UserName;
               if Macro = 'FNOME' then TempLine := TempLine + UserFName;
               if Macro = 'EMAIL' then TempLine := TempLine + UserEMail;
               if Macro = 'REGCODE' then TempLine := TempLine + UserRegCode;
               if Macro = 'CURDATE' then TempLine := TempLine + Current_Date;
               if Macro = 'CURTIME' then TempLine := TempLine + Current_Time;
               if Macro = 'CURDOW' then TempLine := TempLine + Current_DOW;
               if Macro = '' then TempLine := TempLine + '@';

               Macro := '';
               Tempflag := false;

          end;
          inc(I);

     end;

     if I <= Length(Line) then
          TempLine := TempLine + Buffer[I];

     if Line <> '' then
         writeln(DestFile,TempLine)
     else
         writeln(DestFile);

end; {WriteMacroLine}


(* ------------------------------------------------------------------ *)
function DoInet(Nome: string): string;
begin

    if pos(Nome, '@') > 0 then
        DoInet := copy(Nome, 1, pos(Nome, '@')-1)
    else
        DoInet := Nome;

end; {DoInet}

(* ---------------------------------------------------------------------- *)
Procedure FolderHeader(Var F: Text);
var y, m, d, dow: Word;
    month, day: String;

begin

    Rewrite(F);
    GetDate(y, m, d, dow);
    Str(m, month);
    Str(d, day);
    if length(month) = 1 then month := '0' + month;
    if length(day) = 1 then day := '0' + day;
    Writeln(F,'Offline Xpress Message Folder File - Created on ', y, '-', month, '-', day);
    Writeln(F);

end;



(* ====================================================================== *)
begin {Main Program}

    Logo;                     {Logotipo inicial do programa}

    if paramstr(1)='' then
    begin
         writeln('Use EOECMAIL YO to run');
         writeln;
         halt;
    end;

    assign(Users, 'C:\EOEC\USERS.DAT');
    assign(Main1, 'C:\EOEC\MALAD1');
    assign(Main2, 'C:\EOEC\MALAD2');
    assign(MalaDir, 'C:\EOEC\MALADIR.SAV');

    reset(Users);
    rewrite(MalaDir);

    for C := 1 to 6 do readln(Users, Buffer);

    while not Eof(Users) do
    begin

          readln(Users, Buffer);
          if (Buffer[26] <> ' ') and (Buffer[26] <> 'Ä') and (copy(Buffer, 17, 3) <> 'STI') then
          begin

                UserName  := RTrim(copy(Buffer, 26, 26));
                UserEmail := RTrim(copy(Buffer, 54, 40));
                write('Processing Internet user: ', UserName, '                    '+#13);
                TotalUsers := TotalUsers + 1;

                UserFName   := Capitalize(FirstName(UserName));
                UserRegCode := RegCode(UserName);

                reset(Main1);
                while not eof(Main1) do
                begin
                    readln(Main1, Buffer);
                    WriteMacroLine(MalaDir, Buffer);
                end;
          end
          else if (Buffer[26] <> ' ') and (Buffer[26] <> 'Ä') and (copy(Buffer, 17, 3) = 'STI') then
          begin

                UserName    := RTrim(copy(Buffer, 26, 26));
                write('Processing STI user: ', UserName, '                    '+#13);
                TotalUsers := TotalUsers + 1;
                UserFName   := Capitalize(FirstName(UserName));
                UserRegCode := RegCode(UserName);

                reset(Main2);
                while not eof(Main2) do
                begin
                    readln(Main2, Buffer);
                    WriteMacroLine(MalaDir, Buffer);
                end;

          end;

    end;

    writeln;

    Logo;
    writeln('Total processed: ',TotalUsers);
    writeln;
    writeln('Produced file: C:\EOEC\MALADIR.SAV');

    close(MalaDir);
    close(Main2);
    close(Main1);
    close(Users);

end. {Main Program}