program OLX_Editor_Caller;

{$M $4000,0,0 }   { 16K stack, no heap }

uses
    Crt, Dos;

var
    Buffer  : string;       {Buffer tempor rio para leitura de arquivo}
    hdr     : text;         {Arquivo HEADER.DAT}
    ori     : text;         {Arquivo ORIGINAL}
    rep     : text;         {Arquivo REPLY}
    F       : text;         {Arquivo Texto Tempor rio}
    reeditflag : boolean;   {Reedi‡„o de mensagem, Reeditflag = TRUE}
    newflag    : boolean;   {Mensagem nova, Neflag = TRUE}
    InternetFlag: boolean;
    work    : String[38];   {Diret¢rio de trabalho}
    reply   : String[50];   {Arquivo REPLY, com PATH}
    original: String[50];
    header  : String[50];
    number  : byte;
    C       : Byte;
    SeuNome : String[25];
    SeuHandle : String[25];
    SeuEditor : String;
    SeuEditorParam: String;
    SeuLogo   : String;
    SeuInternetLogo: String;
    SeuTaglines : String;

(* ---------------------------------------------------------------------- *)
function GetLine(Var FileVar: Text; Line: Word): String;
var Counter: Integer;
    TempLine: String[128];
begin
     if Line = 0 then
     begin
          Getline := '';
          Exit;
     end;
     Counter := 0;
     reset(FileVar);
     while (Counter < Line) and not(Eof(FileVar)) do
     begin
          Readln(FileVar, TempLine);
          Inc(Counter);
     end;
     if Eof(FileVar) then
         GetLine:= '** EOF **'
     else
         GetLine:= TempLine;
Close(FileVar);
end;

(* ---------------------------------------------------------------------- *)
function FileString(Var FileVar: Text; Line: Word; Pos: Byte; Len: Byte): String;
{Recebe uma vari vel File, Linha, Posi‡„o e tamanho e retorna o conte£do
desse lugar no arquivo File }
var FullLine: String[128];

begin
FullLine := GetLine(FileVar,Line);
if FullLine = '** EOF **' then
    FileString := ''
else
    FileString := Copy(FullLine, Pos, Len);
end;

(* ---------------------------------------------------------------------- *)
function Trim(Str1: String): String;
{ Retira espa‡os em branco depois de determinada String }
var  C: Byte;
     I: Byte;
begin
C := Length(Str1);
I := Length(Str1);
while Copy(Str1,C,1) = ' ' do
begin
     dec(C);
     if Copy(Str1,C,1) <> ' ' then I := C;
end;
Trim := Copy(Str1,1,I);
end;

(* ---------------------------------------------------------------------- *)
function Upper(s: String): String;
{Retorna uma String em letras mai£sculas}
var  i : Integer;

begin
for i := 1 to length(s) do
    s[i] := UpCase(s[i]);
Upper := s;
end;

(* ---------------------------------------------------------------------- *)
function Lower(s: String): String;
var  x : Byte;

begin
for x := 1 to Length(s) do
     if ord(s[x]) in [65..90] then s[x] := chr(ord(s[x])+32);
Lower := s;
end;

(* ---------------------------------------------------------------------- *)
function Capitalize(Str1: String): String;
var  Str : Array[1..201] of String[1];
     Cnt1: Integer;
     Cp  : String;

begin
Str1 := Lower(Str1);
Cp := '';
if length(Str1) > 200 then Halt;
for Cnt1 := 1 to length(Str1) do
    Str[Cnt1] := Copy(Str1,Cnt1,1);
Str[1] := Upper(Str[1]);
for Cnt1 := 2 to length(Str1)+1 do
    if Str[Cnt1]=' ' then
       Str[Cnt1+1] := Upper(Str[Cnt1+1]);
for Cnt1 := 1 to Length(Str1) do
    Cp := Cp + Str[Cnt1];
Capitalize := Cp;
if Cp = 'Vocˆ' then Capitalize := 'vocˆ';
if Cp = 'Mim' then Capitalize := 'mim';

End;

(* ---------------------------------------------------------------------- *)
function FileExists(FileName: String): Boolean;
{ Boolean function that returns True if the file exists; otherwise,
 it returns False. Closes the file if it exists. }
var  F: file;
begin
     {$I-}
     Assign(F, FileName);
     FileMode := 0;  { Set file access to read only }
     Reset(F);
     Close(F);
     {$I+}
     FileExists := (IOResult = 0) and (FileName <> '');
end; { FileExists }

(* ---------------------------------------------------------------------- *)
procedure CursorOff;
var Regs : Registers;
begin
Regs.ah := 1;
Regs.ch := 1;
Regs.cl := 0;
Intr($10,Regs);
end;

(* ---------------------------------------------------------------------- *)
procedure CursorOn;
var Regs : Registers;
begin
Regs.ah := 1;
Regs.ch := 6;
Regs.cl := 7;
Intr($10,Regs);
end;

(* ---------------------------------------------------------------------- *)
function GetFileName(Param1: String): String;
{Retorna apenas o nome do arquivo com extens„o, se for entrado o path e nome}
var
    Fullname : String;   {nome completo do arquivo}
    Counter  : Integer;  {Contador para achar o '\'}
Begin
Fullname := Param1;
For Counter := Length(Fullname) DownTo (Length(Fullname)-12) Do Begin
    If Copy(Fullname, Counter, 1) = '\' Then Begin
        GetFileName := Copy(Fullname, Counter+1, 13);
        Counter := Length(Fullname)-12;
    End;
End;
End;

(* ---------------------------------------------------------------------- *)
function GetPathName(Param1: String): String;
{Retorna apenas o diret¢rio de um arquivo entrado}
var
    Fullname : String;   {nome completo do arquivo}
    Counter  : Integer;  {Indice dentro do Fullname para achar o '\'}
Begin
Fullname := Param1;
For Counter := Length(Fullname) DownTo (Length(Fullname)-12) Do Begin
    If Copy(Fullname, Counter, 1) = '\' Then Begin
        GetPathName := Copy(Fullname, 1, Counter);
        Counter := Length(Fullname)-12;
    End;
End;
End;

(* ---------------------------------------------------------------------- *)
procedure Logo; {Logo de programado por Ernesto Baschny}
begin
HighVideo;
writeln('EOEC v1.0 - Ernst OLX Editor Caller');
LowVideo;
writeln('Programado por Ernsto Baschny, 1994');
writeln;
end; {Logo}

(* ---------------------------------------------------------------------- *)
procedure Verify_Param; {Verifica os parƒmetros passados ao programa}
begin
if paramcount<>2 then
begin
     writeln('Sintaxe: EOEC <EOEC.CFG> <REPLY>');
     halt(1);
end;
if not FileExists(GetPathName(paramstr(2))+'NUL') then
begin
     writeln('N„o existe o diret¢rio ', GetPathName(paramstr(2)));
     halt(1);
end;
end; {Verify_Param}

(* ---------------------------------------------------------------------- *)
procedure CfgRead;    {Lˆ configura‡„o do arquivo}
var cfgfile : Text;
    I : Byte;

begin
Assign(cfgfile, paramstr(1));
Reset(cfgfile);
Readln(cfgfile,Buffer);
if Buffer <> '** EOEC 1.0 CONFIG FILE **' then
begin
     textcolor(lightred);
     writeln('ERRO: O arquivo ', paramstr(1), ' n„o cont‚m a configura‡„o do EOEC');
     textcolor(lightgray);
     writeln;
     writeln('Este arquivo ‚ um arquivo texto no formato:');
     writeln;
     writeln(' 1: ** EOEC 1.0 CONFIG FILE **');
     writeln(' 2: <SEU NOME>');
     writeln(' 3: <SEU HANDLE>');
     writeln(' 4: <TEXT-EDITOR>');
     writeln(' 5: <LOGO.TXT>');
     writeln(' 6: <INTERNET.LGO>');
     writeln(' 7: <TAGS.DAT>');
     writeln;
     writeln(' A primeira linha ‚ necess ria e deve ser exatamente essa.');
     writeln;
     writeln(' A numera‡„o ‚ o n£mero de cada linha e n„o deve ser incluso.');
     halt(1);
end;

readln(cfgfile, Buffer);
SeuNome := Upper(Buffer);
readln(cfgfile, Buffer);
SeuHandle := Upper(Buffer);
readln(cfgfile, Buffer);
I := 0;
for C := Length(Buffer) downto 0 do
begin
     if (C = 0) and (I = 0) then I := Length(Buffer)+1;
     if (C > 0) and (Copy(Buffer,C,1) = ' ') then I := C;
end;

SeuEditor := Copy(Buffer,1,I-1);
SeuEditorParam := Copy(Buffer,I+1,Length(Buffer)-I);

readln(cfgfile, Buffer);
SeuLogo := Upper(Buffer);
readln(cfgfile, Buffer);
SeuInternetLogo := Upper(Buffer);
readln(cfgfile, Buffer);
SeuTaglines := Upper(Buffer);

if not FileExists(SeuLogo) then
begin
     textcolor(lightred);
     writeln('ERRO: N„o foi achado o arquivo com sua assinatura especificado como ' ,SeuLogo);
     textcolor(lightgray);
     writeln;
     writeln('Verifique a linha 5 do arquivo ',paramstr(1),'.');
     writeln;
     halt(2);
end;

if not FileExists(SeuInternetLogo) then
begin
     textcolor(lightred);
     writeln('ERRO: N„o foi achado o arquivo com sua assinatura Internet especificado como ' ,SeuInternetLogo);
     textcolor(lightgray);
     writeln;
     writeln('Verifique a linha 6 do arquivo ',paramstr(1),'.');
     writeln;
     halt(2);
end;

if not FileExists(SeuTaglines) then
begin
     textcolor(lightred);
     writeln('ERRO: N„o foi achado o arquivo com TAGLINES especificado como ',SeuTaglines);
     textcolor(lightgray);
     writeln;
     writeln('Verifique a linha 7 do arquivo ',paramstr(1),'.');
     writeln;
     halt(2);
end;

end;


(* ---------------------------------------------------------------------- *)
procedure CreateVars;    {Cria as vari veis de acordo com os arquivos}
begin

reply    := GetFileName(paramstr(2));
work     := GetPathName(paramstr(2));
reply    := work + reply;
original := work + 'ORIGINAL';
header   := work + 'HEADER.DAT';

reeditflag := False;
newflag    := False;

end; {CreateVars}

(* ---------------------------------------------------------------------- *)
procedure DoHeader;    {Coloca um HEADER na mensagem}
var MsgPacket: String[8];
    MsgDate  : String[8];
    MsgTime  : String[5];
    MsgFrom, MsgTo, MsgSubj, MsgNewTo : String[25];
    MsgArea, MsgNewArea: String[3];
    MsgAreaName: String[25];
    MsgNetAdress: String[15];
    C, I, I1, I2: Byte;

begin
Reset(ori);
Readln(ori);
Readln(ori, Buffer);
MsgPacket := Trim(Copy(Buffer,9,8));     {Pacote: 'STIBBS'}
Readln(ori, Buffer);
MsgDate   := Trim(Copy(Buffer,7,8));     {Data: 'DD-MM-AA'}
MsgTime   := Copy(Buffer,17,5);          {Hora: 'HH:MM'}
Readln(ori, Buffer);
MsgFrom   := Trim(Copy(Buffer,7,25));    {From: 'xxxxxxxx'}
Readln(ori, Buffer);
MsgTo     := Trim(Copy(Buffer,7,25));    {To: 'xxxxxxxxx'}
Readln(ori, Buffer);
MsgSubj   := Trim(Copy(Buffer,7,25));    {Subj: 'xxxxxxxxx'}
MsgArea   := Copy(Buffer,45,3);
Close(ori);
if Copy(MsgArea,2,1) = ')' then MsgArea := Copy(MsgArea,1,1);
if Copy(MsgArea,3,1) = ')' then MsgArea := Copy(MsgArea,1,2);
MsgNewArea := GetLine(hdr,5);
MsgNewTo   := GetLine(hdr,3);

If MsgNewArea = '201' then InternetFlag := True;

{if ((MsgArea = '80') and (MsgNewArea = '80')) or ((MsgArea = '30') and (MsgNewArea = '30')) then
begin
     reset(ori);
     readln(ori,Buffer);
     while Copy(Buffer,1,7) <> '
MSGID:' do
     begin
          readln(ori,Buffer);
          if Eof(ori) then
          begin
               writeln('Erro no Netmail, n„o possui endere‡o');
               readkey;
               halt;
          end;
     end;
     MsgNetAdress := Copy(Buffer,9,15);
     I := Length(MsgNetAdress);
     C := 1;
     repeat
           if MsgNetAdress[C] = '@' then break;
           inc(C);
     until C = I;
     MsgNetAdress := Copy(MsgNetAdress,1,C-1);
     writeln('Preparando netmail para: ',MsgTo, ' em ',MsgNetAdress);
     Rewrite(rep);
     writeln(rep,'-> ',MsgNetAdress);
     writeln(rep);
end
else
if ((MsgArea <> '80') and (MsgNewArea = '80')) or ((MsgArea <> '30') and (MsgNewArea = '30')) then
begin
     Reset(ori);
     repeat
          if Eof(ori) then
          begin
               Writeln('Erro 1!!!');
               Readkey;
               halt;
          end;
          Readln(ori,Buffer);
     until (Copy(Buffer,1,9) = ' * Origin');
     if Copy(Buffer,Length(Buffer),1) <> ')' then Readln(ori,Buffer);
     I := Length(Buffer);
     C := 1;
     while C <> I do
     begin
           inc(C);
           if Buffer[C] = '(' then I1 := C;
     end;
     I := Length(Buffer);
     C := 0;
     while C <> I do
     begin
           inc(C);
           if Buffer[C] = ')' then I2 := C;
     end;
     MsgNetAdress := Copy(Buffer,I1+1,I2-I1-1);
     writeln('Preparando netmail para: ',MsgTo, ' em ',MsgNetAdress);
     Rewrite(rep);
     writeln(rep,'-> ',MsgNetAdress);
     writeln(rep);
end
else}
     Rewrite(rep);

if (MsgNewArea <> MsgArea) and (InternetFlag = False) then
begin
     if Length(MsgArea) = 1 then MsgAreaName := Trim(FileString(ori,6,48,25));
     if Length(MsgArea) = 2 then MsgAreaName := Trim(FileString(ori,6,49,25));
     if Length(MsgArea) = 3 then MsgAreaName := Trim(FileString(ori,6,50,25));
     writeln(rep,' ú úúúùù--ÄÄÄÄÄÄ- Resposta a mensagem original em ',MsgAreaName,' (',MsgArea,')');
     writeln(rep);
end;

if (Upper(MsgTo) = Upper(SeuNome)) or (Upper(MsgTo) = Upper(SeuHandle)) then
   MsgTo := 'mim';
if (Upper(MsgFrom) = Upper(MsgNewTo)) then
   MsgFrom := 'vocˆ';

If InternetFlag = False then
begin
     writeln(rep,' ú úúúùù--ÄÄÄÄÄÄ- No dia ',MsgDate,' …s ',MsgTime,', ',Capitalize(MsgFrom),' escreveu');
     writeln(rep,' ú úúúùù--ÄÄÄÄÄÄ- para ',Capitalize(MsgTo),' sobre ',MsgSubj,':');
     writeln(rep);
end;

end;

(* ---------------------------------------------------------------------- *)
procedure DoBottom;    {Coloca assinatura e tagline}
Var Taglines : Word;
begin

Append(rep);

If InternetFlag = True then
    Assign(F,SeuInternetLogo)
else
    Assign(F,SeuLogo);

Reset(F);

while not Eof(F) do
begin
     Readln(F, Buffer);
     Writeln(rep, Buffer);
end;
writeln(rep);
Close(F);
if InternetFlag = False then
begin
     Taglines := 0;
     Assign(F,SeuTaglines);
     Reset(F);
     while not Eof(F) do
     begin
          Readln(F);
          Inc(Taglines);
     end;
     Randomize;
     Append(rep);
     writeln(rep,'C:\> ',GetLine(F,Random(Taglines)));
end;

Close(rep);

end;

(* ---------------------------------------------------------------------- *)
procedure ShareDelay(Tempo: Byte);
{D  um delay de "tempo" segundos, com mensagem de pausa}

begin
CursorOff;
while Tempo > 0 do
begin
     write('Pausa por ',Tempo,' segundos...   ',Chr(13));
     delay(1000);
     dec(Tempo);
end;
writeln('Ok. Pausa encerrada.                          ');
CursorOn;
end;

(* ====================================================================== *)
begin {Main Program}
Logo;                     {Logotipo inicial do programa}
Verify_Param;             {Verifica a entrada de um parƒmetro (REPLY)}
CreateVars;               {Cria vari veis work, reply, original e header}
CfgRead;

assign(rep,reply);        {Arquivo REPLY = rep}
assign(hdr,header);       {Arquivo HEADER.DAT = hdr}
assign(ori,original);     {Arquivo ORIGINAL = ori}

InternetFlag := False;

if FileExists(reply) then   {Verifica se a mensagem ‚ reedi‡„o de mensagem}
    Reeditflag := True      {pr¢pria ou n„o      1a edi‡„o    Reedi‡„o}
else                                   {           Ori Rep     Ori Rep}
    if not FileExists(original) then   {  New       n   n       n   s }
        Newflag := True;               {  Reply     s   n       s   s }
                                       {  Mensagem minha        s   s }

if (not Reeditflag) and (not Newflag) then
begin
     DoHeader;
     Append(rep);
     Reset(ori);
     for C := 1 to 7 do readln(ori);
     while not Eof(ori) do
     begin
           readln(ori,Buffer);
           writeln(rep,Buffer);
     end;
     Close(rep);
     Close(ori);
end;

SwapVectors;
Exec(SeuEditor,SeuEditorParam+' '+reply);
SwapVectors;

if not FileExists(reply) then
begin
     clrscr;
     TextColor(LightRed);
     writeln('ERRO: N„o foi criado um arquivo de resposta: ',reply);
     TextColor(LightGray);
     CursorOff;
     readkey;
     CursorOn;
     halt(1);
end;

if not Reeditflag then DoBottom;

clrscr;
writeln('Obrigado por usar o EOEC v1.0.');
writeln;
writeln('Contate ERNESTO BASCHNY para retirar essa mensagem. N„o ‚ necess rio');
write('nenhum pagamento. ');
TextColor(White);
write('Este programa ‚ Freeware.');
TextColor(LightGray);
writeln(' Esta atitude ‚ somente para');
writeln('que eu possa manter o controle de quem o usa.');
writeln;
ShareDelay(0);

end. {Main Program}