Program TrojanTrap;

{***************************************************************************}
{*#                                                                       #*}
{*# TrojanTrap v1.45 - File virus trapper.                                #*}
{*#                                                                       #*}
{*# Auteurs          : G.Hughes & S.M.                                    #*}
{*# Compilateur      : PCQ Pascal v1.2b.                                  #*}
{*# Assembleur       : A68k v2.61.                                        #*}
{*# Linker           : Blink v5.02.                                       #*}
{*#                                                                       #*}
{***************************************************************************}

{**************************** Includes *************************************}

{$O-}
{$I "include:utils/Parameters.i"}
{$I "include:utils/StringLib.i"}
{$I "include:libraries/Dos.i"}
{$I "include:exec/execbase.i"}

{************************- Variables globales -*****************************}

CONST
   LineLen         = 100;{ Longueur maximum d'une ligne de la startup }
   CommandLen      = 100;{ Longueur maximum pour une commande }
   NumExtendBytes  = 5;{ Nombre "d'extended bytes"}
   BuffSize        = 33;{ Taille du buffer de lecture}
   TVersion        = "V140";
   BGS9           = "devs/           ";
   BGS9Mut        = "devs/ à         ";
   BretHawnes     = "À à À";
   Butonic        : Array [1..NumExtendBytes] of Integer = (243,1,3,74,78);
   Butonics3      = "   ";   
   Disaster       = "cls *"; 
   Liberator      = "MemCheck s";
   RevengeLamer   = "     ";
   Terrorists     = "           ";
   NumResComs     = 33;
   ResidentList   : Array [1..NumResComs] OF String = ("Alias","Ask","CD",
                    "Echo","Else","EndCLI","EndIf","EndShell","EndSkip",
                    "FailAt","Fault","Get","Getenv","If","Lab","NewCLI",
                    "NewShell","Path","Prompt","Quit","Resident","Run",
                    "Set","Setenv","Skip","Stack","Unalias","Unset",
                    "Unsetenv","Why",".ket",".bra",".key");
TYPE
   ModeType    = (None,Install,Simple,Deep,Extended,Help);
   SysVector   = RECORD
                    Vector : Address;
                 End;
   PathNode    = RECORD
                    Path : String;
                    Next : ^PathNode;
                 End;
   PathNodePtr = ^PathNode;

VAR
   Parameter   : String;
   Found       : FileLock;
   OldLock     : FileLock;
   InitialLock : FileLock;
   LockPath    : String;
   Sucess      : BOOLEAN;
   SequenceLen : Integer;
   LastSeqLen  : Integer;
   ActualValLen: Integer;
   Buffer      : ARRAY[1..BuffSize] OF CHAR;
   Mode        : ModeType;
   ExtBytes    : ARRAY [1..NumExtendBytes] OF Integer;
   PathList    : PathNodePtr;
   KickVersion : Short;

{*************************+ Définitions des procédures +********************}

Procedure WriteHex(num : Integer);
var
    Result : Array [1..8] of Char;
    index  : Short;

    Function ToHex(n : Integer) : Char;
    begin
	if (n < 10) then begin
	    ToHex := Chr(n + Ord('0'))
	end ELSE begin
	    ToHex := Chr(n - 10 + Ord('A'));
        end;
    end;
begin
    for index := 8 downto 1 do begin
	Result[index] := ToHex(num and 15);
	num := num DIV 16;
    end;
    Write("$",Result);
end;

{***************************************************}
{* Procédure pour établir une liste vide au départ.*}
{***************************************************}
Procedure StartList (VAR L : PathNodePtr);
BEGIN
   New(L);
   L^.Path := AllocString(CommandLen);
   L^.Next := Nil;
End;

{**************************************************}
{* Procédure pour ajout d'un élément à la liste   *}
{**************************************************}
Procedure NewPath (VAR L : PathNodePtr;              {* Sommet du Path  *}
                   VAR N : String);                  {* Nouveau Path    *}
Var
   NNode : PathNodePtr;
BEGIN
   New(NNode);
   NNode^.Path := AllocString(CommandLen);
   strcpy(NNode^.Path,N);
   NNode^.Next := L;
   L := NNode;
End;

{**************************************************}
{** Procédure pour enlever un élément à la liste **}
{**************************************************}
Procedure RemovePath (VAR L:PathNodePtr);
Var
   ONode : PathNodePtr;
BEGIN
   ONode := L^.Next;
   Dispose(L);
   L := ONode;
End;

{************************************************************************}
{** Procédure pour vérifier un fichier et avertir si un virus type III **}
{** est présent                                                        **}
{************************************************************************}

Procedure CheckFile (PathName:String;FLen:Integer);
Const
   Smallest   = 150;
Var
   InFile     : FileHandle;
   TestBuffer : Array[1..Smallest] OF CHAR;
   Readin     : Integer;
   TestLWord  : ^SysVector;
   FHunkLen   : Integer;
   FHunkStart : Integer;
   FileTag    : Integer;
   TestTagA   : Integer;
   TestTagB   : Integer;
BEGIN
 IF (FLen>=Smallest) THEN begin   
   New(TestLWord);
   InFile := DOSOpen(PathName,1005);
   If (InFile<>Nil) THEN begin
      Readin := DOSRead(InFile,adr(TestBuffer),Smallest);
      DOSClose(InFile);
   End{* IF *};
   TestLWord := adr(TestBuffer);
   FileTag   := integer(TestLWord^.Vector);
   IF FileTag = 1011 THEN begin
      {* It's executable *}
      TestLWord := address(integer(adr(TestBuffer))+20);
      {* Find length of first hunk *}
      FHunkLen  := integer(TestLWord^.Vector);
      TestLWord := address(integer(adr(TestBuffer))+8);
      IF (((integer(TestLWord^.Vector)*4)+8)<Smallest) THEN begin
         {* Calculate byte position of first hunk *}
         FHunkStart:= 28+((integer(TestLWord^.Vector))*4);
         TestLWord := address((integer(adr(TestBuffer)))+FHunkStart);
         TestTagA  := integer(TestLWord^.Vector);
         TestLWord := address((integer(adr(TestBuffer)))+FHunkStart+4);
         TestTagB  := integer(TestLWord^.Vector);
         {************************************}
         {**--   IRQ team virus présent ? --**}
         {************************************}
         IF (FHunkLen=$109) THEN begin
            IF ((TestTagA=$48e7fffe) AND (TestTagB=$610000BC)) THEN begin
               Write(Chr(155),"2;32;40m**Alert!** ",chr(155),"2;31;40m");
               TestLWord := address(integer(adr(TestBuffer))+24);
               TestTagA  := integer(TestLWord^.Vector);
               IF TestTagA <> $109 THEN begin
                  WriteLn(PathName," infected with an IRQ virus.");
               end ELSE begin
                  WriteLn(PathName," infected with an IRQ mutant virus.");
               End;
            End;
         End;
         {*************************************}
         {**--  Centurion virus présent ?  --**}
         {*************************************}
         IF (FhunkLen=$3CF) THEN begin
            IF (TestTagA=$60026068) THEN begin
               Write(Chr(155),"2;32;40m**Alert!** ",chr(155),"2;31;40m");
               WriteLn(PathName," infected with the Centurions virus.");
            End;
            IF (TestTagA=$2026068) THEN begin
               Write(Chr(155),"2;32;40m**Alert!** ",chr(155),"2;31;40m");
               WriteLn(PathName," infected with the Centurions II virus.");
            End;
         End;
         {******************************}
         {**-- Xeno virus présent ? --**}
         {******************************}
         IF ((TestTagA=$48E7F0EE) AND (TestTagB=$2C780004)) THEN begin
            Write(Chr(155),"2;32;40m**Alert!** ",chr(155),"2;31;40m");
            WriteLn(PathName," infected with the Xeno virus.");
         End;
         {******************************}
         {**-- CCCP virus présent ? --**}
         {******************************}
         IF (FHunkLen=$FD) THEN begin
            IF ((TestTagA=$48E7FFFE) AND (TestTagB=$2078006C)) THEN begin
               Write(Chr(155),"2;32;40m**Alert!** ",chr(155),"2;31;40m");
               WriteLn(PathName," infected with the CCCP virus.");
            End;
         End;
         {**************************************}
         {**-- Gotcha Lamer virus présent ? --**}
         {**************************************}
         IF (FHunkLen=$54) THEN begin
            IF ((TestTagA=$48E7FFFE) AND (TestTagB=$2C780004)) THEN begin
               Write(Chr(155),"2;32;40m**Alert!** ",chr(155),"2;31;40m");
               WriteLn(PathName," infected with the Gotcha Lamer virus.");
            End;
         End;
         {*******************************************}
         {**-- Travelling Jack I virus présent ? --**}
         {*******************************************}
         IF ((TestTagA=$6100000A) AND (TestTagB=$2F3C0000)) THEN begin
            TestLWord := address((integer(adr(TestBuffer)))+FHunkStart+8);
            TestTagA  := integer(TestLWord^.Vector);
            TestLWord := address((integer(adr(TestBuffer)))+FHunkStart+12);
            TestTagB  := integer(TestLWord^.Vector);
            IF ((TestTagA=$00004E75) AND (TestTagB=$48E7FFFE)) THEN begin   
               Write(Chr(155),"2;32;40m**Alert!** ",chr(155),"2;31;40m");
               WriteLn(PathName," infected with the Travelling Jack I virus.");
            End;
         End;
         {********************************************}
         {**-- Travelling Jack II virus présent ? --**}
         {********************************************}
         IF ((TestTagA=$487A0008) AND (TestTagB=$487A000A)) THEN begin
            TestLWord := address(integer(adr(TestBuffer))+FHunkStart+8);
            TestTagA  := integer(TestLWord^.Vector);
            TestLWord := address(integer(adr(TestBuffer))+FHunkStart+12);
            TestTagB  := integer(TestLWord^.Vector);
            IF ((TestTagA=$4E754EF9) AND (TestTagB=$00000000)) THEN begin   
               Write(Chr(155),"2;32;40m**Alert!** ",chr(155),"2;31;40m");
               WriteLn(PathName," infected with the Travelling Jack II virus.");
            End;
         End;
         {*********************************************}
         {**-- Travelling Jack III virus présent ? --**}
         {*********************************************}
         IF ((TestTagA=$485041FA) AND (TestTagB=$000C4E90)) THEN begin
            TestLWord := address(integer(adr(TestBuffer))+FHunkStart+8);
            TestTagA  := integer(TestLWord^.Vector);
            TestLWord := address(integer(adr(TestBuffer))+FHunkStart+12);
            TestTagB  := integer(TestLWord^.Vector);
            IF ((TestTagA=$205F4EF9) AND (TestTagB=$00000000)) THEN begin   
               Write(Chr(155),"2;32;40m**Alert!** ",chr(155),"2;31;40m");
               WriteLn(PathName," infected with the Travelling Jack III virus.");
            End;
         End;
      End;
   End;
   Dispose(TestLWord);
 End;
End;
{**************************************************************************}
{**         Fonction pour retourner la longueur d'une commande           **}
{**************************************************************************}

FUNCTION GetLen(FilePath : String) : Integer;
VAR
  SPath       : String;
  FileLen     : Integer;
  NewFilePath : String;
  Loop        : Integer;
  StepUp      : Integer;
  Details     : FileInfoBlockPtr;
  BuffFile    : Text;
  Located     : BOOLEAN;
  LocatePath  : PathNodePtr;
BEGIN
   FileLen := 0;
   StepUp  := 0;
   Located := False;
   SPath   := AllocString(3);
   strcpy(SPath,"c:");
   NEW(LocatePath);
   Found := Lock(FilePath,access_read);
   IF (Found = nil) THEN begin
      {*********************************************************}
      {** lock sur le fichier impossible : testez autre path. **}
      {*********************************************************}
      NewFilePath := AllocString(CommandLen+3);
      NewPath(PathList,SPath);
      LocatePath := PathList;
      WHILE ((Located=FALSE) AND (LocatePath^.Next<>Nil)) DO begin
         strcpy(NewFilePath,LocatePath^.Path);
         Strcat(NewFilePath,FilePath);
         Found := Lock(NewFilePath,access_read);
         IF (Found <> nil) THEN begin
            {***********************************************************}
            {** On trouve et il faut retourner la longueur du fichier **}
            {***********************************************************}
            Located := TRUE;
            NEW(Details);
            Sucess := Examine(Found,Details);
            FileLen := Details^.fib_Size;
            DISPOSE(Details);
            unlock(Found);
            IF ((Mode=Extended) OR (Mode=Install)) Then begin
               IF (FileLen >= BuffSize) THEN begin
                  Sucess := ReOpen(NewFilePath,BuffFile);
                  IF Sucess=True THEN begin
                     Read(BuffFile,Buffer);
                     ExtBytes[1] := (ORD(Buffer[4]));
                     ExtBytes[2] := (ORD(Buffer[12]));
                     ExtBytes[3] := (ORD(Buffer[23]));
                     ExtBytes[4] := (ORD(Buffer[24]));
                     ExtBytes[5] := (ORD(Buffer[33]));
                     Close(BuffFile);
                  End;
                  CheckFile(NewFilePath,FileLen);
               end ELSE begin
                  FOR Loop := 1 TO NumExtendBytes DO begin
                     ExtBytes[Loop] := -1;
                  End;
               End;
            End;
            FreeString(NewFilePath);
         End;
         LocatePath := LocatePath^.Next;
      End;
      RemovePath(PathList);
      IF (Located=FALSE) THEN begin
         {**************************************}
         {** La commande est-elle résidente ? **}
         {**************************************}
         IF (KickVersion=4) THEN begin
            Loop := 1;
            WHILE ((Located=FALSE) AND (Loop<=NumResComs)) DO begin
               IF strieq(ResidentList[Loop],FilePath)=TRUE THEN begin
                  Located  := TRUE;
                  FOR Loop := 1 TO NumExtendBytes DO begin
                     ExtBytes[Loop] := -2;
                  END;
                  FileLen := 0;
               End;
               Inc(Loop);
            End;
         End;
         IF (Located=FALSE) THEN begin
            {*****************************************************}
            {** Fonction inconnue des chemins (paths) possibles **}
            {*****************************************************}
            Write(FilePath);
            WriteLn(" not found!");
         End;
      END {* IF *};
   end ELSE begin
      {******************************************************************}
      {** On a trouvé le fichier et on cherche d'autres renseignements **}
      {******************************************************************}
      NEW(Details);
      Sucess := Examine(Found,Details);
      FileLen := Details^.fib_Size;
      DISPOSE(Details);
      unlock(Found);
      IF ((Mode=Extended) OR (Mode=Install)) Then begin
         IF (FileLen >= BuffSize) THEN begin
            Sucess := ReOpen(NewFilePath,BuffFile);
            IF Sucess=True THEN begin
               Read(BuffFile,Buffer);
               ExtBytes[1] := (ORD(Buffer[4]));
               ExtBytes[2] := (ORD(Buffer[12]));
               ExtBytes[3] := (ORD(Buffer[23]));
               ExtBytes[4] := (ORD(Buffer[24]));
               ExtBytes[5] := (ORD(Buffer[33]));
               Close(BuffFile);
            End;
            CheckFile(NewFilePath,FileLen);
         end ELSE begin
            FOR Loop := 1 TO NumExtendBytes DO begin
               ExtBytes[Loop] := -1;
            End;
         End;
      End;
   End;
   GetLen := FileLen;
End;

{*************************************************}
{** Procédure analyse : elle fait 90% du boulot **}
{*************************************************}

PROCEDURE Analyse;
VAR
   Count       : Integer;
   MoveTo      : Integer;
   Insert      : Integer;
   TextIn      : Char;
   TextChunk   : String;
   InString    : String;
   FLen        : Integer;
   Letters     : Integer;
   InFile      : Text;
   OutFile     : Text;
   DataIn      : Text;
   NumComs     : Integer;
   PrevCount   : Integer;
   OldName     : String;
   OldLen      : Integer;
   OldExtBytes : ARRAY [1..NumExtendBytes] OF Integer;
   AllOK       : BOOLEAN;
   StructOK    : BOOLEAN;
   PTVersion   : String;
   GenOK       : BOOLEAN;
   NextFile    : FileInfoBlockPtr;
   NPath       : String;

BEGIN
   {** Allocate storage for the strings we use **}
   InString  := AllocString(LineLen);
   TextChunk := AllocString(CommandLen);
   OldName   := AllocString(CommandLen);
   PTVersion := AllocString(6);
   NPath     := AllocString(CommandLen);
   AllOK     := TRUE;
   NumComs   := 0;
   StartList (PathList);
   strcpy(PathList^.Path,":c/");

   Sucess := ReOpen(":s/Startup-Sequence",InFile);
   IF (Sucess = TRUE) THEN begin
      {*************************************}
      {** On a trouvé la startup-sequence **}
      {*************************************}
      IF (Mode=Install) THEN begin
         Sucess := Open(":s/TrojanTrap.data",OutFile);
      end ELSE begin
         Sucess := ReOpen(":s/TrojanTrap.data",DataIn);
      End;
      IF (Sucess = TRUE) THEN begin
         IF (Mode=Install) THEN begin
            SequenceLen := GetLen(":s/Startup-Sequence");
            WriteLn(OutFile,TVersion);
            WriteLn(OutFile,SequenceLen);
         end ELSE begin
            {************************************************}
            {** Vérifie la validité de la startup-sequence **}
            {************************************************}
            InitialLock := NIL;
            ReadLn(DataIn,PTVersion);
            IF (((strieq(PTVersion,"V130"))=True) OR ((Strnieq(PTVersion,"V",1))=False)) THEN begin
               WriteLn("\n**** Old TrojanTrap data file format, please reinstall ****");
               Exit(10)
            End;
            ReadLn(DataIn,LastSeqLen);
            SequenceLen := GetLen(":s/Startup-Sequence");
            IF (SequenceLen = LastSeqLen) THEN begin
               WriteLn("Startup-Sequence Len hasn't changed.");
               AllOK := TRUE;
            end else begin
               Write(Chr(155),"2;33;40mAlert! ",chr(155),"2;31;40m");
               WriteLn("** Startup-Sequence length has changed **");
               AllOK := FALSE;
            end;
         End;

         IF (Mode = Simple) Then begin
            IF (AllOK = TRUE) Then begin
               exit(0);
            end ELSE begin
               WriteLn("Investigating...");
               Mode := Deep;
               AllOK := TRUE;
            End;
         End;

         InitialLock := NIL;
         {******************************************************}
         {** Tant que l'on a pas atteint la fin de la startup **}
         {******************************************************}
         WHILE (EOF(InFile)=FALSE) DO begin
            INC(NumComs);
            {********************************}
            {** Initialisation des chaînes **}
            {********************************}
            FOR Letters := 0 TO (LineLen-1) DO begin
               InString[Letters] := chr(0);
            end;
            FOR Letters := 0 TO (CommandLen-1) DO begin
               OldName[Letters] := chr(0);
               TextChunk[Letters] := chr(0);
            end;
            {********************************************}
            {** Lire une ligne de la startup-sequence  **}
            {********************************************}
            Count  := 0;
            MoveTo := 0;
            ReadLn(InFile,InString);
            {**********************************}
            {** Cherche la ligne de commande **}
            {**********************************}
            TextIn := InString[Count];
            StructOK := TRUE;
            WHILE ((ORD(TextIn)<>0)AND(Count<=30)AND(StructOK=TRUE)
                  and(ORD(TextIn)<>13)) DO begin
               IF (((ORD(TextIn)=32)OR(ORD(TextIn)=9)) AND (MoveTo = 0)) THEN begin
                  INC(Count);
                  TextIn := InString[Count];
               end ELSE begin
                  IF ((ORD(TextIn)<>32) AND (ORD(TextIn)<>9)) THEN begin
                     TextChunk[MoveTo] := TextIn;
                     INC(MoveTo);
                     INC(Count);
                     TextIn := InString[Count];
                  end else begin
                     StructOK := FALSE;
                  End;
               End;
            end;
            {**********************************}
            {** Revenge Of The Lamer Virus ? **}
            {**********************************}
            Sucess := strieq(InString,RevengeLamer);               
            IF (Sucess=True) THEN begin
               Write(Chr(155));
               Write("2;33;40m*Alert!* ");
               Write(chr(155),"2;31;40mPossible infection from");
               WriteLn(" Revenge Of The Lamer virus,test with virus killer.");
               Exit(10);
            End;
            IF ((ORD(TextChunk[0])<>59) AND (ORD(TextChunk[1])<>0)) Then begin
               FLen := 0;
               FLen := GetLen(TextChunk);
               IF ((FLen>0) AND (Mode = Install)) THEN begin
                  WriteLn(OutFile,TextChunk);
                  WriteLn(OutFile,FLen);
                  FOR Letters := 1 TO NumExtendBytes DO begin
                     WriteLn(OutFile,ExtBytes[Letters]);
                  End;
               end;
               IF (((Mode = Deep)OR(Mode = Extended))AND(FLEN>0)) THEN begin
                  IF (EOF(DataIn) = FALSE) THEN begin
                     ReadLn(DataIn,OldName);
                     ReadLn(DataIn,OldLen);
                     FOR Letters := 1 TO NumExtendBytes DO begin
                        ReadLn(DataIn,OldExtBytes[Letters]);
                     End;
                     {*********************}
                     {** Virus de Type I **}
                     {*********************}
                     {****************************}
                     {** BGS-9 & virus mutant ? **}
                     {****************************}
                     If ((FLen=2608)) THEN begin
                        Found := Lock(BGS9,Access_Read);
                        IF (Found <> Nil) THEN begin
                           UnLock(Found);
                           Write(Chr(155));
                           Write("2;33;40m*Alert!* ");
                           Write(chr(155),"2;31;40mPossible infection with the");
                           WriteLn(" BGS-9 virus,test with virus killer.");
                        end;
                        Found := Lock(BGS9Mut,Access_Read);
                        IF (Found <> Nil) THEN begin
                           UnLock(Found);
                           Write(Chr(155));
                           Write("2;33;40m*Alert!* ");
                           Write(chr(155),"2;31;40mPossible infection with the");
                           WriteLn(" BGS9 mutant virus,test with virus killer.");
                        end;                    
                     End;
                     {***********************}
                     {** Terrorist virus ? **}
                     {***********************}
                     If ((FLen=1612)) THEN begin
                        Found := Lock(Terrorists,Access_Read);
                        IF (Found <> Nil) THEN begin
                           UnLock(Found);
                           Write(Chr(155));
                           Write("2;33;40m*Alert!* ");
                           Write(chr(155),"2;31;40mPossible infection with the");
                           WriteLn(" Terrorists virus,test with virus killer.");
                        end;
                     End;
                     {*************************}
                     {** Bret Hawnes virus ? **}
                     {*************************}
                     Sucess := Strieq(InString,BretHawnes);
                     IF ((Sucess=True)and(Flen=2608)) THEN begin
                        Write(Chr(155));
                        Write("2;33;40m*Alert!* ");
                        Write(chr(155),"2;31;40mPossible infection with ");
                        WriteLn("Bret Hawnes virus,test with virus killer.");
                     end;
                     {********************************}
                     {** Jeff Butonics 3.00 virus ? **}
                     {********************************}
                     Sucess := Strieq(InString,Butonics3);
                     IF ((Sucess=True)and(Flen=2916)) THEN begin
                        Write(Chr(155));
                        Write("2;33;40m*Alert!* ");
                        Write(chr(155),"2;31;40mPossible infection with ");
                        WriteLn("Jeff Butonic 3 virus,test with virus killer.");
                     end;
                     {********************************}
                     {** Jeff Butonics 1.31 virus ? **}
                     {********************************}
                     Sucess := True;
                     For Letters := 1 TO NumExtendBytes DO begin
                        If (ExtBytes[Letters] <> Butonic[Letters]) THEN begin
                           Sucess := False;
                        End;
                     end;
                     IF ((Sucess=True)and(Flen=3408)) THEN begin
                        Write(Chr(155));
                        Write("2;33;40m*Alert!* ");
                        Write(chr(155),"2;31;40mPossible infection with ");                       
                        WriteLn("Jeff Butonic Virus,test with virus killer.");
                     end;
                     {*************************}
                     {** Disaster Master 2 ? **}
                     {*************************}
                     Sucess := Strieq(InString,Disaster);
                     IF ((Sucess=True)and(Flen=1740)) THEN begin
                        Write(Chr(155));
                        Write("2;33;40m*Alert!* ");
                        Write(chr(155),"2;31;40mPossible infection with ");
                        WriteLn("Disaster Master virus,test with virus killer.");
                     end;
                     {***********************}
                     {** Liberator virus ? **}
                     {***********************}
                     Sucess := Strieq(InString,Liberator);
                     IF (Sucess=True) THEN begin
                        Write(Chr(155));
                        Write("2;33;40m*Alert!* ");
                        Write(chr(155),"2;31;40mPossible infection with ");
                        WriteLn("Liberator virus,test with virus killer.");
                     end;
                     {***************************************}
                     {** Vérifie si même ligne de commande **}
                     {***************************************}
                     Sucess := Strieq(Oldname,TextChunk);
                     IF (Sucess = FALSE) THEN begin
                        Write(chr(155),"2;33;40mAlert! ",chr(155));
                        Write("2;31;40m",TextChunk);
                        WriteLn(" found instead of ",OldName);
                        AllOK := FALSE;
                     End;
                     StructOK := True;
                     {******************************}
                     {** Vérifie en extended mode **}
                     {******************************}
                     IF Mode = Extended THEN begin
                        FOR Letters := 1 TO NumExtendBytes DO begin
                           IF ((ExtBytes[Letters] <>OldExtBytes[Letters]) AND
                              (StructOK = TRUE)) THEN begin
                              Write(chr(155),"2;33;40mAlert! ",chr(155));
                              Write("2;31;40m");
                              Write("Internal structure of file ");
                              Write(OldName);
                              WriteLn(" has changed.");
                              StructOK := FALSE;
                              AllOK := FALSE;
                              IF ((OldExtBytes[letters] = -1) OR
                                 (ExtBytes[Letters] = -1)) THEN begin
                                 Mode := deep;
                                 StructOK := FALSE;
                              End;
                           End {* IF *};
                        End {* FOR *};
                     End {* FOR *};
                     {****************}
                     {** Deep mode  **}   
                     {****************}
                     IF (Mode = Deep) THEN begin
                        IF OldLen <> FLen THEN begin
                           Write(chr(155),"2;33;40mAlert! ",chr(155));
                           Write("2;31;40m");
                           Write("Altered file length found on file- ");
                           WriteLn(OldName);
                           AllOK := FALSE;
                        End;
                        IF StructOK = FALSE Then begin
                           Mode := Extended;
                        End;
                     End;
                  end ELSE begin
                     Write(chr(155),"2;33;40mAlert! ",chr(155));
                     Write("2;31;40m");
                     WriteLn("extra command found: ",TextChunk);
                     AllOK := FALSE;
                  End;
               End{* IF *};
               {*******************}
               {* Commande CD ?   *}
               {*******************}
               IF (Strieq(TextChunk,"CD") = TRUE) Then begin
                  {*********************************}
                  {** Initialisation de la chaîne **}
                  {*********************************}
                  FOR Letters := 0 TO (CommandLen-1) DO begin
                     TextChunk[Letters] := chr(0);
                  End{* FOR *};
                  {***********************}
                  {** Cherche le chemin **}
                  {***********************}
                  PrevCount := Count;
                  Insert    := 0;
                  Inc(Count);
                  TextIn    := InString[Count];
                  WHILE ((TextIn<>';')AND(ORD(TextIn)<>0)AND
                  (Count<=(30-PrevCount))) DO begin
                     IF TextIn <> '"' THEN begin
                        TextChunk[Insert] := TextIn;
                        INC (Insert);
                     End {* IF *};
                     INC (Count);
                     TextIn := InString[Count];
                  End {* WHILE *};
                  {***************************}
                  {** Changer de répertoire **}
                  {***************************}
                  Found := Lock(TextChunk,access_read);
                  IF Found <> NIL THEN begin
                     OldLock := CurrentDir(Found);
                     IF InitialLock = NIL Then begin
                        InitialLock := OldLock;
                     End;
                     Unlock(OldLock);
                  end else begin
                     Write(Chr(155),"2;33;40mCan't change into directory: ");
                     Write(chr(155),"2;31;40m");
                     WriteLn(TextChunk);
                     Exit(10);
                  end;
               End;
               {****************************}
               {** La commande est path ? **}
               {****************************}
               IF (Strieq(TextChunk,"PATH") = TRUE) Then begin
                  {*********************************}
                  {** Initialisation de la chaîne **}
                  {*********************************}
                  FOR Letters := 0 TO (CommandLen-1) DO begin
                     TextChunk[Letters] := chr(0);
                  End{* FOR *};
                  {***********************}
                  {** Cherche le chemin **}
                  {***********************}
                  PrevCount := Count;
                  WHILE ((Count<=(CommandLen-PrevCount))  AND
                         (strieq(TextChunk,"ADD")=FALSE)   AND
                         (ORD(TextIn)<>0) ) DO begin
                     FOR Letters := 0 TO (CommandLen-1) DO begin
                        TextChunk[Letters] := chr(0);
                     End{* FOR *};
                     Insert    := 0;
                     Inc(Count);
                     TextIn    := InString[Count];
                     WHILE (TextIn=' ') DO begin
                        INC(Count);
                     END {* WHILE *};
                     WHILE ((TextIn<>';')AND(ORD(TextIn)<>0)AND
                     (Count<=(CommandLen-PrevCount))AND(TextIn<>' ')) DO begin
                        IF TextIn <> '"' THEN begin
                           TextChunk[Insert] := TextIn;
                           INC (Insert);
                        End {* IF *};
                        INC (Count);
                        TextIn := InString[Count];
                     End {* WHILE *};
                     IF strieq(TextChunk,"ADD")=FALSE THEN begin
                        IF ((TextChunk[strlen(TextChunk)-1] <> ':')
                           and (TextChunk[strlen(TextChunk)-1] <> '/')) THEN begin
                           strcat(TextChunk,"/");
                        End;            
                        NewPath(PathList,TextChunk);
                     END;
                  End{* WHILE *};
               End{* IF *};
            End{* IF *};
         End{* WHILE *};
         IF Mode = Install THEN begin
            WriteLn("Installation sucessful.");
            Close(OutFile);
         end ELSE begin
            IF (EOF(DataIn) = FALSE) THEN begin
               WriteLn("Missing commands from startup-sequence -");
               WHILE (EOF(DataIn) = FALSE) DO begin
                  FOR Letters := 0 TO (CommandLen-1) DO begin
                      OldName[Letters] := chr(0);
                  end;
                  ReadLn(DataIn,OldName);
                  ReadLn(DataIn,OldLen);
                  FOR Letters := 1 TO NumExtendBytes DO begin
                     ReadLn(DataIn,OldExtBytes[Letters]);
                  End;
                  WriteLn(OldName);
               End;
            end ELSE begin
               Close(DataIn);
            End;
         End;
      end else begin
         IF Mode = Install THEN begin
            {**********************************************}
            {** je n'arrive pas à ouvrir le fichier data **}
            {**********************************************}
            Write(Chr(155));
            WriteLn("2;33;40mUnable To open output file!",chr(155),"2;31;40m");
         end else begin
            WriteLn("Unable to open data file, try using <I>nstall first.");
         End;
      end{* IF *};
      Close(InFile);
   end else begin
      {**********************************************}
      {** Je ne trouve pas la startup-sequence ... **}
      {**********************************************}
      Write(Chr(155));
      WriteLn("2;33;40mUnable To open Startup-Sequence!",chr(155),"2;31;40m");
   end;
   IF InitialLock <> NIL THEN begin
      OldLock := CurrentDir(InitialLock);
   End;
   IF ((Mode = Deep) OR (Mode = Extended)) THEN begin
      IF AllOk THEN begin
         WriteLn("Startup-sequence not changed/intercepted");
      end ELSE begin
         WriteLn("Startup-sequence changed/intercepted.");
         WriteLn("Check highlighted files with virus killer, then reinstall.");
      End;
   End;
   WHILE (PathList<>Nil) DO begin
      RemovePath(PathList);
   End{* WHILE *};
   FreeString(InString);
   FreeString(TextChunk);
   FreeString(OldName);
   FreeString(PTVersion);
end;

{*******************************}
{** Vérifie le disk-validator **}
{*******************************}

PROCEDURE CheckValidator;
VAR
   InFile  : Text;
   Valid   : BOOLEAN;
   Saddam  : BOOLEAN;
   Lamer   : BOOLEAN;
   VBuffer : ARRAY[1..128] OF CHAR;

BEGIN
   Valid  := TRUE;
   Saddam := FALSE;
   Lamer  := FALSE;
   Sucess :=Reopen(":l/Disk-Validator",InFile);
   IF Sucess = TRUE Then begin
      {**************************************}
      {** Lire les permiers 128 caractères **}
      {**************************************}
      Read(InFile,VBuffer);

      {****************************}
      {** Vérifie ces 128 bytes. **}
      {****************************}
      IF (ORD(VBuffer[4]) <> 243) THEN begin
         Valid := FALSE;
      End;
      IF (ORD(VBuffer[37]) <> 71) THEN begin
         Valid := FALSE;
      End;
      IF (ORD(VBuffer[24]) <> 197) THEN begin
         Valid := FALSE;
      End;
      IF (ORD(VBuffer[55]) <> 108) THEN begin
         Valid := FALSE;
      End;
      IF (ORD(VBuffer[73]) = 175 ) THEN begin
         Saddam := True;
         Valid  := False;
      End;
      IF (ORD(VBuffer[73]) = 90) THEN begin
         Lamer := True;
         Valid := False;
      end;
      IF (Valid = TRUE) THEN begin
         Write("Disk-Validator O.K. ");
      end else begin
         IF (Saddam = TRUE) THEN begin
            Write(chr(155),"2;33;40mAlert! ",chr(155));
            Write("2;31;40m");
            WriteLn("Saddam Hussein virus found, use TrojanTrauma immediatly!");
         end ELSE begin
            IF (Lamer = True) THEN begin
               Write(chr(155),"2;33;40mAlert! ",chr(155));
               Write("2;31;40m");
               WriteLn("Return Of The Lamer virus found, use TrojanTrauma immediatly!");
            end ELSE begin
               Write("Non standard V1.2/V1.3 disk validator found ");
            End;
         End;
      end;
      Close(InFile);
   end else begin
   Write("Couldn't find Disk-Validator ");
   end;
end;

PROCEDURE CheckMemory;
Const
   ExecName    = "exec.library";
   Version     = 0;
   TrackName   = "trackdisk.device";
   NumVectors  = 4;
   NumVersions = 4;
Var
   ExecBasePtr   : ^ExecBase;
   MemClear      : BOOLEAN;
   MemNew        : ^SysVector;
   DoIO          : ^SysVector;
   TrackBase     : NodePtr;
   Track_BeginIO : ^SysVector;
   Track_Close   : ^SysVector;
   DListptr      : ^SysVector;
   RasterInt     : ^SysVector;
   RasterBad     : BOOLEAN;
   RealVectors   : Array[1..NumVectors,1..NumVersions] OF Address;
   BadCold       : address;
   BadCool       : address;
   BadWarm       : address;
   BadKickTag    : address;
   BadRaster     : address;
Begin
   RealVectors[1,1] := address($FC06DC);{* 1.2  DoIO *}
   RealVectors[1,2] := address($FC0718);{* 1.3  DoIO *}
   RealVectors[1,3] := address($F808B4);{* 2.0  DoIO *}
   RealVectors[1,4] := address($F80808);{* 2.04 DoIO *}
   RealVectors[2,1] := address($FE9FBE);{* 1.2  Track_BeginIO *}
   RealVectors[2,2] := address($FE9C3E);{* 1.3  Track_BeginIO *}
   RealVectors[2,3] := address($FB9A48);{* 2.0  Track_BeginIO *}
   RealVectors[2,4] := address($FD03B4);{* 2.04 Track_BeginIO *}
   RealVectors[3,1] := address($FC6CDC);{* 1.2  Raster_Int *}
   RealVectors[3,2] := address($FC6D48);{* 1.3  Raster_Int *}
   RealVectors[3,3] := address($FBDB1C);{* 2.0  Raster_Int *}
   RealVectors[3,4] := address($FA1850);{* 2.04 Raster_Int *}
   RealVectors[4,1] := address($FE9F92);{* 1.2  Track_Close *}
   RealVectors[4,2] := address($FE9C12);{* 1.3  Track_Close *}
   RealVectors[4,3] := address($FB9A26);{* 2.0  Track_Close *}
   RealVectors[4,4] := address($FD0392);{* 2.04 Track_Close *}
   MemClear := TRUE;
   New(ExecBasePtr);
   Disable;
   ExecBasePtr := OpenLibrary(ExecName,Version);
   If (ExecBasePtr <> Nil) THEN begin
      RasterInt := address(integer(ExecBasePtr) + 144);
      RasterInt := RasterInt^.Vector;
      RasterInt := RasterInt^.Vector;
      RasterInt := address(integer(RasterInt)+18);
      RasterBad := False;
      KickVersion := ExecBasePtr^.LibNode.lib_Version;
      IF ((KickVersion<33) OR (KickVersion>37)) THEN begin
         Write("\n<*** KickStart rev ",KickVersion," unsupported, send the vector");
         WriteLn(" values to me! ***>\n");
      End;
      IF (KickVersion = 33) THEN begin
         KickVersion := 1;
      end ELSE begin
         IF (KickVersion = 34) THEN begin
            KickVersion := 2;
         end ELSE begin
            IF (KickVersion = 36) THEN begin
               KickVersion := 3;
            end ELSE begin
               IF (KickVersion = 37) THEN begin
                  KickVersion := 4;
               end ELSE begin
                  KickVersion := 4;
               End;
            End;
         End;
      End;
      If (KickVersion <>0) THEN begin
         IF (RasterInt^.Vector <> RealVectors[3,KickVersion]) THEN begin
            RasterBad := True;
            BadRaster := RasterInt^.Vector;
            RasterInt^.Vector := RealVectors[3,KickVersion];
         End;
      End;
      Enable;
      BadCold := ExecBasePtr^.ColdCapture;
      IF integer(ExecBasePtr^.ColdCapture) <> 0 THEN begin
         MemClear := FALSE;
         MemNew := ExecBasePtr^.ColdCapture;
         ExecBasePtr^.ColdCapture := Nil;
         MemNew^.Vector := address($4e750000);    
      End;
      BadCool := ExecBasePtr^.CoolCapture;      
      IF integer(ExecBasePtr^.CoolCapture) <> 0 THEN begin
         MemClear := FALSE;
         MemNew := ExecBasePtr^.CoolCapture;
         ExecBasePtr^.CoolCapture := Nil;
         MemNew^.Vector := address($4e750000);    
      End;
      BadWarm := ExecBasePtr^.WarmCapture;
      IF integer(ExecBasePtr^.WarmCapture) <> 0 THEN begin
         MemClear := FALSE;
         MemNew := ExecBasePtr^.WarmCapture;
         ExecBasePtr^.WarmCapture := Nil;
         MemNew^.Vector := address($4e750000);    
      End;
      BadKickTag := ExecBasePtr^.KickTagPtr;
      IF integer(ExecBasePtr^.KickTagPtr) <> 0 THEN begin
         MemClear := FALSE;
         ExecBasePtr^.KickCheckSum := Nil;
         ExecBasePtr^.KickMemPtr   := Nil;
         ExecBasePtr^.KickTagPtr   := Nil;
      End;
      IF (MemClear=False) THEN begin
         Write("\n",chr(155),"2;33;40mAlert! ",chr(155));
         Write("2;31;40m");
         WriteLn("reset vectors have been altered\n");         
         Write("ColdCapture  ");
         WriteHex(integer(BadCold));
         Write("  CoolCapture  ");
         WriteHex(integer(BadCool));
         Write("  WarmCapture  ");
         WriteHex(integer(BadWarm));
         Write("\nKickTagPtr   ");
         WriteHex(integer(BadKickTag));
         Write("  KickMemPtr   ");
         WriteHex(integer(ExecBasePtr^.KickMemPtr));
         Write("  KickCheckSum ");
         WriteHex(integer(ExecBasePtr^.KickCheckSum));
         WriteLn;
         WriteLn("<<<<<<<<<<<< Reset Vectors clear reset to terminate virus >>>>>>>>>>>>");         
      end ELSE begin
         WriteLn("<<< reset vectors O.K. >>>");
      End;

      DoIO          := address(integer(ExecBasePtr)-454);
      DListptr      := address(integer(ExecBasePtr)+350);
      TrackBase     := FindName(DListptr^.Vector,TrackName);
      Track_BeginIO := address(integer(TrackBase)-28);
      Track_Close   := address(integer(TrackBase)-10);

      If (KickVersion <>0) THEN begin
         IF (DoIO^.Vector <> RealVectors[1,KickVersion]) THEN begin
            Write("DoIO intercepted : ");
            WriteHex(integer(DoIO^.Vector));
            WriteLn;
            DoIO^.Vector := RealVectors[1,KickVersion];
         End;
      End;
      If (KickVersion <>0) THEN begin
         IF (Track_BeginIO^.Vector <> RealVectors[2,KickVersion]) THEN begin
            Write("TrackDisk Begin_IO intercepted : ");
            WriteHex(integer(Track_BeginIO^.Vector));
            WriteLn;
            Track_BeginIO^.Vector := RealVectors[2,Kickversion];
         End;
      End;
      If (KickVersion <>0) THEN begin
         IF (Track_Close^.Vector <> RealVectors[4,KickVersion]) THEN begin
            Write("TrackDisk_Close intercepted : ");
            WriteHex(integer(Track_Close^.Vector));
            WriteLn;
            Track_Close^.Vector := RealVectors[4,Kickversion];
         End;
      End;
      IF (RasterBad = True) THEN begin
         Write("RasterInt intercepted : ");
         WriteHex(integer(BadRaster));
         WriteLn;         
      End;
   End;
   Dispose(ExecBasePtr);
   Dispose(MemNew);
End;

PROCEDURE Usage;
BEGIN
   WriteLn("Usage : TrojanTrap <?> <I>nstall <S>imple <D>eep <E>xtended.");
   Exit(5);
End;

{**************************************************************************}
{***************************## Entrée Main  ##*****************************}
{**************************************************************************}

BEGIN

   Mode := None;
   {***************}
   {** paramètre **}
   {***************}
   Parameter := AllocString(1);
   GetParam(1,Parameter);

   {*********************}
   {* Pas d'arguments ? *}
   {*********************}
   IF StrLen(Parameter) = 0 THEN begin
      Usage;
   end;

   {**********************}
   {** Ecrire l'en-tête **}
   {**********************}
   Write("\f",chr(155));
   Write("2;32;40mTrojanTrap v1.45 - ");
   Write(chr(155),"2;31;40m");
   Write(chr(155));
   Write('2;32;40m',chr(169)," Greg Hughes 1991,1992");
   Write(chr(155));
   Write("2;31;40m,All Rights Reserved");
   WriteLn(chr(155),"2;31;40m");
   WriteLn("This version authorised for distribution with Master Virus Killer."); 

   {********************************************************}
   {** Vérifie le disk-validator contre le SHV ou le ROLE **}
   {********************************************************}
   CheckValidator;

   {************************}
   {** Vérifie la mémoire **}
   {************************}
   CheckMemory;

   {******************}
   {** Mode install **}
   {******************}
   IF (strieq(Parameter,"I")=TRUE) THEN begin
      Mode := Install;
      Analyse;
   end;

   {*************************}
   {** Vérification simple **}     
   {*************************}
   IF (strieq(Parameter,"S")=TRUE) THEN begin
      Mode := Simple;
      Analyse;
   end;

   {*******************************************}
   {** Vérification plus poussée : mode Deep **}
   {*******************************************}
   IF (strieq(Parameter,"D")=TRUE) THEN begin
      Mode := Deep;
      WriteLn("Performing Deep analysis");
      Analyse;
   end;

   {*****************}
   {** Mode étendu **}
   {*****************}
   IF (strieq(Parameter,"E")=TRUE) THEN begin
      Mode := Extended;
      WriteLn("Performing Extended analysis");
      Analyse;
   end;

   IF streq(Parameter,"?")=TRUE THEN begin
      Mode := Help;
      Write("\nHELP mode - TrojanTrap is a program which monitors your ");
      WriteLn("Startup-sequence,");
      Write("alerting you when changes occur at a user selectable level ");
      WriteLn("of checking.");
      WriteLn("For further info read the docs.");
      WriteLn;
      Usage;
      WriteLn;
   end;

   IF Mode=None Then begin
      WriteLn;
      Usage;
   End;

   FreeString(Parameter);
END.