home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / virus / delouse1.zip / DELOUSE.PAS < prev    next >
Pascal/Delphi Source File  |  1988-03-03  |  12KB  |  354 lines
  1. PROGRAM DELOUSE;
  2.  
  3.    (************************************************************************)
  4.    (*  This source code and the compiled program are placed in the public  *)
  5.    (*  domain for free and unlimited distribution. The author retains no   *)
  6.    (*  rights and imposes no restrictions. The author requests that        *)
  7.    (*  credit be given as a courtesy when the code or portion of the code  *)
  8.    (*  is used in a commercial product. If you can't do that much then may *)
  9.    (*  a diseased camel dribble in your soup.       Phil Nickell.          *)
  10.    (************************************************************************)
  11.  
  12. Uses dos;
  13.  
  14. Const
  15.   DataSize   = 60000;                 { working buffer size }
  16.   Dataname   = 'DELOUSE.DAT';         { filename source file }
  17.   CheckName  = 'DELOUSE.CHK';         { checksum data file }
  18.   CheckBack  = 'DELOUSE.OLD';         { backup copy of checksum data }
  19.   Make       : boolean = false;       { true = make, false = check }
  20.  
  21. Type
  22.   CheckType  = String[11];
  23.   NameType   = String[13];
  24.   PathType   = String[80];
  25.   ArrayType  = Array[1..DataSize] of byte;
  26.   ArrayPtr   = ^ArrayType;
  27.  
  28. Var
  29.   FileData  : Arrayptr;
  30.   HeapTop   : Pointer;
  31.   FilePath  : PathType;
  32.   Method    : Word;                   { checksum calculation method 1,2 or 3 }
  33.   ErrorLevl : Word;
  34.  
  35. (**********************************)
  36. (* Bailout - console help message *)
  37. (**********************************)
  38. Procedure Bailout;
  39.   begin
  40.     Writeln;
  41.     Writeln('DELOUSE - a tool to assist in checking for damage by trojan & virus programs.');
  42.     Writeln;
  43.     Writeln('  DELOUSE reads a file named DELOUSE.DAT which is a list of file names to');
  44.     Writeln('  check. If the ''MAKE'' option is used, DELOUSE will create a file named');
  45.     Writeln('  DELOUSE.CHK which is a list of those file names and a checksum calculated');
  46.     Writeln('  from each file.  If the ''CHECK'' option is used DELOUSE will compare the');
  47.     Writeln('  DELOUSE.CHK checksum data against the files named there and report if any');
  48.     Writeln('  of the files have been modified.');
  49.     Writeln;
  50.     Writeln('  DELOUSE.DAT should be a plain text file, each line containing a full path');
  51.     Writeln('  name for the file. It should be in the current (default) directory.');
  52.     Writeln('  DELOUSE.CHK will be created in the current directory when the MAKE option');
  53.     Writeln('  is used. If DELOUSE.CHK exists it will be renamed to DELOUSE.OLD');
  54.     Writeln;
  55.     Writeln('  Examples:');
  56.     Writeln('    DELOUSE MAKE  <cr>');
  57.     Writeln('    DELOUSE CHECK  <cr>');
  58.     Writeln;
  59.     Writeln(' Please read DELOUSE.DOC for complete information about additional command');
  60.     Writeln(' line options, theory of operation and some cautionary notes.');
  61.     Writeln('     Phil Nickell');
  62.     Halt(1);
  63.   end;
  64.  
  65.  
  66. (******************************************)
  67. (* Exists - check for existence of a file *)
  68. (******************************************)
  69. Function Exists(Path:Pathtype):Boolean;
  70.     Var f:file;
  71.   Begin
  72.     Assign(f,Path);
  73.     {$I-}
  74.     Reset(f);
  75.     {$I+};
  76.     If IoResult = 0 then
  77.       Begin
  78.         Exists := True;
  79.         Close(f);
  80.       end
  81.      else
  82.       Exists := False;
  83.   end;
  84.  
  85. (****************************************************************)
  86. (* Trim - trims a string of leading and trailing blanks *)
  87. (****************************************************************)
  88. Function Trim( S: String): String;
  89.     var i: word;
  90.         T: string;
  91.   begin
  92.     T := s;
  93.     while (length(t) > 0) and (t[1] = ' ') do
  94.       delete(t,1,1);
  95.     while (length(t) > 0) and (t[length(t)] = ' ') do
  96.       delete(t,length(t),1);
  97.     Trim := t;
  98.   end;
  99.  
  100.  
  101. (****************************************************************)
  102. (* Getsum - Given a full file path name...                      *)
  103. (* If the file exists returns a positive long integer ( >= 0 )  *)
  104. (* of the files checksum else returns -1                        *)
  105. (* Uses one of three method for building the checksum. The      *)
  106. (* method used is determined by the global METHOD word.         *)
  107. (****************************************************************)
  108. Function GetSum(Path: PathType): Longint;
  109.   Var    Tempsum : Longint;
  110.          I,
  111.          NumRead : Word;
  112.          ModeSave: Byte;
  113.          FN      : File;
  114.  
  115.   Begin
  116.     GetSum := -1;
  117.     If Length(path) = 0 then exit;
  118.     Tempsum := -1;
  119.     ModeSave := Filemode;
  120.     FileMode := 0;  { input only; allow access to r/o & system files }
  121.     Assign(FN,Path);
  122.     {$I-}
  123.     Reset(fn,1);
  124.     {$I+}
  125.     If ioresult = 0 then
  126.       begin
  127.         TempSum := 38; {age factor}
  128.         Repeat
  129.           BlockRead(Fn,FileData^, DataSize, NumRead);
  130.           If NumRead > 0 then
  131.           case METHOD of
  132.            1: For i := 1 to NumRead do
  133.                If odd(i) then
  134.                 Inc(TempSum, FileData^[i]);
  135.            2: For i := 1 to NumRead do
  136.                If not odd(i) then
  137.                 Inc(TempSum, FileData^[i]);
  138.            3: For i := 1 to NumRead do
  139.                If odd(i) then
  140.                 Dec(TempSum, FileData^[i]);
  141.           end;
  142.         Until NumRead = 0;
  143.         TempSum := Abs(TempSum);
  144.         Close(FN);
  145.       end;
  146.     GetSum := Tempsum;
  147.     FileMode := ModeSave;
  148.   end;
  149.  
  150.  
  151. (*****************************************************************)
  152. (* ScanFiles reads the existing check file and compares the data *)
  153. (* therein against the files named therein, reporting if         *)
  154. (* there are any differences.                                    *)
  155. (*****************************************************************)
  156. Procedure ScanFiles;
  157.   var  InDat    : Text;
  158.        InString : String;
  159.        Path     : PathType;
  160.        CS       : CheckType;
  161.        CV,
  162.        FV       : Longint;
  163.        MethChar : Char;
  164.        Result   : word;
  165.        linenum  : word;
  166.   begin
  167.      linenum := 0;
  168.      If Exists(CheckName) then
  169.        begin
  170.          writeln('CHECKING FILES RECORDED IN ',CHECKNAME,' FILE.');
  171.          writeln;
  172.          Assign(Indat, CheckName);
  173.          Reset(Indat);
  174.          While not eof(indat) do begin
  175.            Instring := '';
  176.            Readln(indat, Instring);
  177.            inc(linenum);
  178.            If (length(instring) > 0) and
  179.               (Copy(instring,1,5) <> '!NOTE') then begin
  180.              If Instring[1] in ['1'..'3'] then
  181.                Method := ord(instring[1]) - ord('0');
  182.              CS := copy(instring,3, pred(sizeof(cs)));
  183.              Val(cs,CV,Result);
  184.              If Result <> 0 then
  185.                begin
  186.                  Writeln;
  187.                  Writeln('Format error in ',Checkname,' file, line ',linenum);
  188.                  Writeln('  ',Instring);
  189.                  Writeln;
  190.                  If errorlevl = 0 then Inc(errorlevl);
  191.                end
  192.               else
  193.                begin
  194.                  Path := Copy(instring,sizeof(cs)+3,length(instring)-(sizeof(cs)+2));
  195.                  Path := trim(path);
  196.                  FV := GetSum(Path);
  197.                  If Fv = -1 then
  198.                    begin
  199.                      Writeln;
  200.                      Writeln('** Warning ** File to check does not exist');
  201.                      Writeln('  File name = ',Path);
  202.                      Writeln;
  203.                      ErrorLevl := 2;   { report serious error }
  204.                    end
  205.                   else if CV <> FV then
  206.                    begin
  207.                      Writeln;
  208.                      Writeln('** WARNING ** Checksum mismatch.');
  209.                      Writeln('  File name = ',Path);
  210.                      Writeln('  Old value = ',cv);
  211.                      Writeln('  Current file value = ',fv);
  212.                      Writeln;
  213.                      ErrorLevl := 2; { report serious error }
  214.                    end
  215.                   else
  216.                    begin
  217.                      Writeln('Match OK - ',Path);
  218.                    end;
  219.              end; {result <> 0}
  220.            end; {length instring}
  221.          end; {while not eof}
  222.          Close(indat);
  223.        end
  224.       else
  225.        begin
  226.          Writeln;
  227.          Writeln('File ',Checkname,' not found - you must run Delouse');
  228.          Writeln(' using the make option to build the check file.');
  229.          Writeln;
  230.          Halt(1);
  231.        end;
  232.   end;
  233.  
  234.  
  235. (*****************************************************************)
  236. (* MakeFiles creates the file DELOUSE.CHK, reads DELOUSE.DAT and *)
  237. (* for each filename in delouse.dat writes the checknum and file *)
  238. (* name into the check file.                                     *)
  239. (*****************************************************************)
  240. Procedure MakeFiles;
  241.     Var ChkFile,
  242.         DatFile : Text;
  243.         CS      : CheckType;
  244.         Path    : PathType;
  245.         MethChar: Char;
  246.         Sum     : Longint;
  247.         W       : Word;
  248.         Linenum : Word;
  249.   begin
  250.     MethChar := chr( Method + ord('0') );
  251.     If Exists(Dataname) then
  252.      begin
  253.        Writeln('BUILDING ',CHECKNAME,' FILE.');
  254.        writeln;
  255.        Linenum := 0;
  256.        Assign (DatFile,Dataname);
  257.        Reset(Datfile);
  258.        Assign (ChkFile,CheckName);
  259.        If Exists(CheckName) then begin
  260.          Assign(ChkFile,CheckBack);
  261.          If Exists(CheckBack) then Erase(ChkFile);
  262.          Assign(ChkFile,CheckName);
  263.          Rename(ChkFile,CheckBack);
  264.          Assign(ChkFile,CheckName);
  265.        end;
  266.        Rewrite(ChkFile);
  267.        Writeln(ChkFile,'!NOTE - This file used by the DELOUSE program. DON''T MODIFY.');
  268.        While Not Eof(DatFile) do begin
  269.          Readln(DatFile,Path);
  270.          Inc(Linenum);
  271.          Path := Trim(Path);
  272.          For w := 1 to length(path) do path[w] :=
  273.             upcase(chr(ord(path[w]) and $7f));
  274.          If Copy(path,1,5) <> '!NOTE' then begin
  275.            If Length(Path) > 0 then begin
  276.              Sum := Getsum(path);
  277.              If Sum >= 0 then begin
  278.                Str( Sum:pred(sizeof(CS)), CS );
  279.                Writeln(Chkfile,Methchar,' ',CS,' ',Path);
  280.                Writeln(Methchar,' ',CS,' ',Path);
  281.              end
  282.               else
  283.              begin
  284.                Writeln;
  285.                Writeln('Error opening file specified by ',Dataname,' line ',linenum);
  286.                Writeln('  Ignoring ',Path);
  287.                Writeln;
  288.                If errorlevl = 0 then Inc(errorlevl);
  289.              end;
  290.            end; { length path }
  291.          end; { path <> note }
  292.        end;
  293.        Close(ChkFile);
  294.        Close(Datfile);
  295.      end
  296.     else
  297.      begin
  298.        Writeln;
  299.        Writeln('File ',Dataname,' not found - you must create or');
  300.        Writeln(' make available ',dataname,' which is a list of file');
  301.        Writeln(' names to check. Please read the documentation.');
  302.        Writeln;
  303.        Halt(1);
  304.      end;
  305.   end;
  306.  
  307. (************************************************)
  308. (* Checks command line for MAKE or CHECK option *)
  309. (* and for METHOD selection flag                *)
  310. (************************************************)
  311. Procedure ParseCommand;
  312.     Var  S: NameType;
  313.          P,
  314.          I: Word;
  315.   begin
  316.     Randomize;
  317.     Method := Succ(random(3));
  318.     For P := 1 to paramcount do
  319.       begin
  320.         S := Paramstr(P);
  321.         For i := 1 to length(s) do s[i] := upcase(s[i]);
  322.         If S = 'MAKE' then make := true;
  323.         If S = 'CHECK' then make := false;
  324.         If Length(s) = 8 then
  325.          If (Copy(s,1,7) = 'METHOD=') and
  326.             (s[8] in ['1'..'3']) then
  327.            Method := ord(s[8]) - ord('0');
  328.       end;
  329.   end;
  330.  
  331.  
  332.  begin { DELOUSE }
  333.    ErrorLevl := 0;
  334.    If ParamCount < 1 then Bailout;
  335.    Mark(Heaptop);
  336.    If Maxavail < DataSize then
  337.      begin
  338.        Writeln;
  339.        Writeln('Program requires ',Datasize-Maxavail,' more bytes of memory.');
  340.        Writeln('Unable to continue.');
  341.        Writeln('Please free up some memory and try again.');
  342.        Writeln;
  343.        Halt(1);
  344.      end;
  345.    New(FileData);
  346.    ParseCommand;
  347.    If Make then
  348.      MakeFiles
  349.     else
  350.      ScanFiles;
  351.    Release(Heaptop);
  352.    Halt(ErrorLevl);
  353.  end.
  354.