Program NetMailTosser;
Uses Crt, Dos;

Const

                         Ext = '.msg';
      CfgFileExist : Boolean = True;
                  UserName10 = 'Sashka Yackubtchick';
                  UserName11 = 'Sashka Yakubchik';
                  UserName12 = 'Sashka Yakubtchik';
                  UserName13 = 'Alexander Yakubchick';
                  UserName14 = 'Alexandr';
                  UserName15 = 'Alexander';
                  UserName16 = 'Sashka';
                  UserName17 = 'Svin';
                  UserName20 = 'Mitya Ostrovsky';
                  UserName30 = 'Anna Yackubtchick';
                  MailPath1 = 'SWIN\';
                  MailPath2 = 'MITYA\';
                  MailPath3 = 'ANNA\';
                         WD = '..\NETMAIL\'; {  Working Directory }
Var

                         LTF : Text;
                       F0,F2 : File;
         NumRead, NumWritten : Word;
                         Buf : Array[1..8192] of Char;
                    DT1, DT2 : DateTime;
                      T1, T2 : LongInt;
                          SR : SearchRec;
                    MailPath : String[80];

Procedure GetMesgAndHalt;
 Begin
  WriteLn(#7#7#7,' IO ERROR ! PROGRAM HALTED ! ');
  Halt;
 End;

Procedure ReWriteCfgFile;
 begin
  CfgFileExist := False;
  ReWrite( LTF );
   If IOResult<>0 then GetMesgAndHalt;
    WriteLn( LTF, 'CFG FILE FOR MAILTOSS.EXE.');
    WriteLn( LTF, 'DO NOT ERASE ! ');
    Close( LTF );
    If IOResult<>0 then GetMesgAndHalt;
 end;

Procedure GetTossTime;
 Begin
  Assign( LTF, 'lasttoss.cfg');
  If FSearch('lasttoss.cfg','')='' then ReWriteCfgFile;
   Reset( LTF );
   If IOResult<>0 then GetMesgAndHalt;
     GetFTime ( LTF, T1 );
     Close ( LTF );
  End;

Procedure CopyFile (  Var Fs, Fd : File );
 Begin
    Reset( Fs, 1 );
    ReWrite( Fd, 1 );
    Repeat
     BlockRead(Fs, Buf, SizeOf(Buf), NumRead);
     BlockWrite(Fd, Buf, NumRead, NumWritten);
    Until (NumRead = 0) or (NumWritten <> NumRead);
    Close( Fs );
    Close( Fd );
 End;

Procedure LookAndCopy( FileName : String );
Const
       StringSize = $24;
Var
        FileBuf : Record
                         Sender : Array[1..StringSize] of Char;
                      Addressee : Array[1..StringSize] of Char;
                     end;
                   F01,F21: File;
 Begin

   Reset(F0, 1);
   BlockRead(F0, FileBuf, SizeOf(FileBuf), NumWritten );
   Close(F0);
   WriteLn('From :',FileBuf.Sender,'  To: ',FileBuf.Addressee);
     If
      (
         (FileBuf.Addressee <> UserName10) and (FileBuf.Sender <> UserName10)
     and (FileBuf.Addressee <> UserName20) and (FileBuf.Sender <> UserName20)
     and (FileBuf.Addressee <> UserName30) and (FileBuf.Sender <> UserName30)
     and (FileBuf.Addressee <> UserName11) and (FileBuf.Sender <> UserName11)
     and (FileBuf.Addressee <> UserName12) and (FileBuf.Sender <> UserName12)
     and (FileBuf.Addressee <> UserName13) and (FileBuf.Sender <> UserName13)
     and (FileBuf.Addressee <> UserName14) and (FileBuf.Sender <> UserName14)
     and (FileBuf.Addressee <> UserName15) and (FileBuf.Sender <> UserName15)
     and (FileBuf.Addressee <> UserName16) and (FileBuf.Sender <> UserName16)
     and (FileBuf.Addressee <> UserName17) and (FileBuf.Sender <> UserName17)
      )
      or
      (FileBuf.Sender = 'AreaFix') or (FileBuf.Sender = 'AllFix')
                                   or (FileBuf.Sender = 'FastEcho AutoCreate')
      then
        begin
            MailPath := MailPath1;
               Assign(F01,WD+FileName);
               Assign(F21, WD+MailPath+FileName);
               CopyFile(F01, F21);
            MailPath := MailPath2;
               Assign(F01,WD+FileName);
               Assign(F21, WD+MailPath+FileName);
               CopyFile(F01, F21);
        end;
   If (FileBuf.Addressee = UserName10) or (FileBuf.Sender=UserName10)
   or (FileBuf.Addressee = UserName11) or (FileBuf.Sender=UserName11)
   or (FileBuf.Addressee = UserName12) or (FileBuf.Sender=UserName12)
   or (FileBuf.Addressee = UserName13) or (FileBuf.Sender=UserName13)
   or (FileBuf.Addressee = UserName14) or (FileBuf.Sender=UserName14)
   or (FileBuf.Addressee = UserName15) or (FileBuf.Sender=UserName15)
   or (FileBuf.Addressee = UserName16) or (FileBuf.Sender=UserName16)
   or (FileBuf.Addressee = UserName17) or (FileBuf.Sender=UserName17)
                              then MailPath := WD+MailPath1;
   If (FileBuf.Addressee = UserName20) or (FileBuf.Sender=UserName20)
                              then MailPath := WD+MailPath2;
   If (FileBuf.Addressee = UserName30) or (FileBuf.Sender = UserName30)
                           then MailPath := WD+MailPath3;
   Assign(F01,WD+FileName);
   Assign(F21, WD+MailPath+FileName);
   CopyFile(F01, F21);

 End;


Procedure WorkWith( FileName : String );
Var FN : String;
 Begin
  FN:=WD+FileName;
  Assign( F0, FN );
  If not CfgFileExist then LookAndCopy( FileName )
                      else
                       begin
                       Reset(F0);
                        GetFTime(F0, T2);
                        Close(F0);
                        If T2 > T1 then LookAndCopy( FileName );
                       end;
 End;

Procedure Scan;
 Begin
  FindFirst(WD+'*'+Ext,Archive, SR );
   while DosError = 0 do
    begin
      WorkWith( SR.Name );
      FindNext( SR );
    end;
 End;


 Begin
  ClrScr;
  GetTossTime;
  Scan;
  ReWriteCfgFile;
 End.