home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
virus
/
delouse1.zip
/
DELOUSE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-03-03
|
12KB
|
354 lines
PROGRAM DELOUSE;
(************************************************************************)
(* This source code and the compiled program are placed in the public *)
(* domain for free and unlimited distribution. The author retains no *)
(* rights and imposes no restrictions. The author requests that *)
(* credit be given as a courtesy when the code or portion of the code *)
(* is used in a commercial product. If you can't do that much then may *)
(* a diseased camel dribble in your soup. Phil Nickell. *)
(************************************************************************)
Uses dos;
Const
DataSize = 60000; { working buffer size }
Dataname = 'DELOUSE.DAT'; { filename source file }
CheckName = 'DELOUSE.CHK'; { checksum data file }
CheckBack = 'DELOUSE.OLD'; { backup copy of checksum data }
Make : boolean = false; { true = make, false = check }
Type
CheckType = String[11];
NameType = String[13];
PathType = String[80];
ArrayType = Array[1..DataSize] of byte;
ArrayPtr = ^ArrayType;
Var
FileData : Arrayptr;
HeapTop : Pointer;
FilePath : PathType;
Method : Word; { checksum calculation method 1,2 or 3 }
ErrorLevl : Word;
(**********************************)
(* Bailout - console help message *)
(**********************************)
Procedure Bailout;
begin
Writeln;
Writeln('DELOUSE - a tool to assist in checking for damage by trojan & virus programs.');
Writeln;
Writeln(' DELOUSE reads a file named DELOUSE.DAT which is a list of file names to');
Writeln(' check. If the ''MAKE'' option is used, DELOUSE will create a file named');
Writeln(' DELOUSE.CHK which is a list of those file names and a checksum calculated');
Writeln(' from each file. If the ''CHECK'' option is used DELOUSE will compare the');
Writeln(' DELOUSE.CHK checksum data against the files named there and report if any');
Writeln(' of the files have been modified.');
Writeln;
Writeln(' DELOUSE.DAT should be a plain text file, each line containing a full path');
Writeln(' name for the file. It should be in the current (default) directory.');
Writeln(' DELOUSE.CHK will be created in the current directory when the MAKE option');
Writeln(' is used. If DELOUSE.CHK exists it will be renamed to DELOUSE.OLD');
Writeln;
Writeln(' Examples:');
Writeln(' DELOUSE MAKE <cr>');
Writeln(' DELOUSE CHECK <cr>');
Writeln;
Writeln(' Please read DELOUSE.DOC for complete information about additional command');
Writeln(' line options, theory of operation and some cautionary notes.');
Writeln(' Phil Nickell');
Halt(1);
end;
(******************************************)
(* Exists - check for existence of a file *)
(******************************************)
Function Exists(Path:Pathtype):Boolean;
Var f:file;
Begin
Assign(f,Path);
{$I-}
Reset(f);
{$I+};
If IoResult = 0 then
Begin
Exists := True;
Close(f);
end
else
Exists := False;
end;
(****************************************************************)
(* Trim - trims a string of leading and trailing blanks *)
(****************************************************************)
Function Trim( S: String): String;
var i: word;
T: string;
begin
T := s;
while (length(t) > 0) and (t[1] = ' ') do
delete(t,1,1);
while (length(t) > 0) and (t[length(t)] = ' ') do
delete(t,length(t),1);
Trim := t;
end;
(****************************************************************)
(* Getsum - Given a full file path name... *)
(* If the file exists returns a positive long integer ( >= 0 ) *)
(* of the files checksum else returns -1 *)
(* Uses one of three method for building the checksum. The *)
(* method used is determined by the global METHOD word. *)
(****************************************************************)
Function GetSum(Path: PathType): Longint;
Var Tempsum : Longint;
I,
NumRead : Word;
ModeSave: Byte;
FN : File;
Begin
GetSum := -1;
If Length(path) = 0 then exit;
Tempsum := -1;
ModeSave := Filemode;
FileMode := 0; { input only; allow access to r/o & system files }
Assign(FN,Path);
{$I-}
Reset(fn,1);
{$I+}
If ioresult = 0 then
begin
TempSum := 38; {age factor}
Repeat
BlockRead(Fn,FileData^, DataSize, NumRead);
If NumRead > 0 then
case METHOD of
1: For i := 1 to NumRead do
If odd(i) then
Inc(TempSum, FileData^[i]);
2: For i := 1 to NumRead do
If not odd(i) then
Inc(TempSum, FileData^[i]);
3: For i := 1 to NumRead do
If odd(i) then
Dec(TempSum, FileData^[i]);
end;
Until NumRead = 0;
TempSum := Abs(TempSum);
Close(FN);
end;
GetSum := Tempsum;
FileMode := ModeSave;
end;
(*****************************************************************)
(* ScanFiles reads the existing check file and compares the data *)
(* therein against the files named therein, reporting if *)
(* there are any differences. *)
(*****************************************************************)
Procedure ScanFiles;
var InDat : Text;
InString : String;
Path : PathType;
CS : CheckType;
CV,
FV : Longint;
MethChar : Char;
Result : word;
linenum : word;
begin
linenum := 0;
If Exists(CheckName) then
begin
writeln('CHECKING FILES RECORDED IN ',CHECKNAME,' FILE.');
writeln;
Assign(Indat, CheckName);
Reset(Indat);
While not eof(indat) do begin
Instring := '';
Readln(indat, Instring);
inc(linenum);
If (length(instring) > 0) and
(Copy(instring,1,5) <> '!NOTE') then begin
If Instring[1] in ['1'..'3'] then
Method := ord(instring[1]) - ord('0');
CS := copy(instring,3, pred(sizeof(cs)));
Val(cs,CV,Result);
If Result <> 0 then
begin
Writeln;
Writeln('Format error in ',Checkname,' file, line ',linenum);
Writeln(' ',Instring);
Writeln;
If errorlevl = 0 then Inc(errorlevl);
end
else
begin
Path := Copy(instring,sizeof(cs)+3,length(instring)-(sizeof(cs)+2));
Path := trim(path);
FV := GetSum(Path);
If Fv = -1 then
begin
Writeln;
Writeln('** Warning ** File to check does not exist');
Writeln(' File name = ',Path);
Writeln;
ErrorLevl := 2; { report serious error }
end
else if CV <> FV then
begin
Writeln;
Writeln('** WARNING ** Checksum mismatch.');
Writeln(' File name = ',Path);
Writeln(' Old value = ',cv);
Writeln(' Current file value = ',fv);
Writeln;
ErrorLevl := 2; { report serious error }
end
else
begin
Writeln('Match OK - ',Path);
end;
end; {result <> 0}
end; {length instring}
end; {while not eof}
Close(indat);
end
else
begin
Writeln;
Writeln('File ',Checkname,' not found - you must run Delouse');
Writeln(' using the make option to build the check file.');
Writeln;
Halt(1);
end;
end;
(*****************************************************************)
(* MakeFiles creates the file DELOUSE.CHK, reads DELOUSE.DAT and *)
(* for each filename in delouse.dat writes the checknum and file *)
(* name into the check file. *)
(*****************************************************************)
Procedure MakeFiles;
Var ChkFile,
DatFile : Text;
CS : CheckType;
Path : PathType;
MethChar: Char;
Sum : Longint;
W : Word;
Linenum : Word;
begin
MethChar := chr( Method + ord('0') );
If Exists(Dataname) then
begin
Writeln('BUILDING ',CHECKNAME,' FILE.');
writeln;
Linenum := 0;
Assign (DatFile,Dataname);
Reset(Datfile);
Assign (ChkFile,CheckName);
If Exists(CheckName) then begin
Assign(ChkFile,CheckBack);
If Exists(CheckBack) then Erase(ChkFile);
Assign(ChkFile,CheckName);
Rename(ChkFile,CheckBack);
Assign(ChkFile,CheckName);
end;
Rewrite(ChkFile);
Writeln(ChkFile,'!NOTE - This file used by the DELOUSE program. DON''T MODIFY.');
While Not Eof(DatFile) do begin
Readln(DatFile,Path);
Inc(Linenum);
Path := Trim(Path);
For w := 1 to length(path) do path[w] :=
upcase(chr(ord(path[w]) and $7f));
If Copy(path,1,5) <> '!NOTE' then begin
If Length(Path) > 0 then begin
Sum := Getsum(path);
If Sum >= 0 then begin
Str( Sum:pred(sizeof(CS)), CS );
Writeln(Chkfile,Methchar,' ',CS,' ',Path);
Writeln(Methchar,' ',CS,' ',Path);
end
else
begin
Writeln;
Writeln('Error opening file specified by ',Dataname,' line ',linenum);
Writeln(' Ignoring ',Path);
Writeln;
If errorlevl = 0 then Inc(errorlevl);
end;
end; { length path }
end; { path <> note }
end;
Close(ChkFile);
Close(Datfile);
end
else
begin
Writeln;
Writeln('File ',Dataname,' not found - you must create or');
Writeln(' make available ',dataname,' which is a list of file');
Writeln(' names to check. Please read the documentation.');
Writeln;
Halt(1);
end;
end;
(************************************************)
(* Checks command line for MAKE or CHECK option *)
(* and for METHOD selection flag *)
(************************************************)
Procedure ParseCommand;
Var S: NameType;
P,
I: Word;
begin
Randomize;
Method := Succ(random(3));
For P := 1 to paramcount do
begin
S := Paramstr(P);
For i := 1 to length(s) do s[i] := upcase(s[i]);
If S = 'MAKE' then make := true;
If S = 'CHECK' then make := false;
If Length(s) = 8 then
If (Copy(s,1,7) = 'METHOD=') and
(s[8] in ['1'..'3']) then
Method := ord(s[8]) - ord('0');
end;
end;
begin { DELOUSE }
ErrorLevl := 0;
If ParamCount < 1 then Bailout;
Mark(Heaptop);
If Maxavail < DataSize then
begin
Writeln;
Writeln('Program requires ',Datasize-Maxavail,' more bytes of memory.');
Writeln('Unable to continue.');
Writeln('Please free up some memory and try again.');
Writeln;
Halt(1);
end;
New(FileData);
ParseCommand;
If Make then
MakeFiles
else
ScanFiles;
Release(Heaptop);
Halt(ErrorLevl);
end.