Category : Miscellaneous Language Source Code
Archive   : STLTH22.ZIP
Filename : VIRCHECK.PAS

 
Output of file : VIRCHECK.PAS contained in archive : STLTH22.ZIP
{$I-}
{
vircheck.pas
Stealth Bomber Version 2.2

Kevin Dean
Fairview Mall P.O. Box 55074
1800 Sheppard Avenue East
Willowdale, Ontario
CANADA M2J 5B9
CompuServe ID: 76336,3114

February 10, 1992

This is the interface to the anti-virus system and CRC checks in the
Stealth Bomber package.

This code is public domain.
}


unit VirCheck;


interface


uses
DOS, DOSMCB, AllocBuf;


type
crc32_t =
longint;

FileCRC =
record
case boolean of
false:
(
SearchStr : array [1 .. 8] of char; { Used by Stealth Bomber package only. }
);

true:
(
Polynomial : crc32_t; { Polynomial for this file. }
CRC : crc32_t; { Calculated CRC for this file. }
);
end;


{ Anti-virus validation return code. }
const
StealthOK = $0000; { No virus found. }
StealthIntrErr = $0001; { Interrupts set beyond the program's code space. }
StealthDOSMemErr = $0002; { DOS memory inconsistent with BIOS memory. }
StealthDOSHijacked = $0004; { DOS interrupt hijacked by JMP FAR or CALL FAR. }
StealthFileErr = $0001; { File not found or unable to open. }
StealthFileDateErr = $0002; { File date/time stamp invalid. }
StealthFileSizeErr = $0004; { File size inconsistent between directory and file open checks. }
StealthCRCBadPoly = $0008; { CRC polynomial is invalid. }
StealthNoMem = $0010; { No memory to perform CRC check. }
StealthCRCInvalid = $0020; { CRC is invalid. }


function StealthSysCheck : word;
function StealthFileCheck(FileName : PathStr; FCRC : FileCRC) : word;


implementation


type
dWordRec =
record
Lo, Hi : word
end;

BytePtr =
^byte;

WordPtr =
^word;

PtrPtr =
^pointer;


{***}
function BIOSMemory : word;

var
Regs : Registers; { Registers in memory check call. }

begin
Intr($12, Regs);
BIOSMemory := Regs.AX;
end;


{***}
{ Determine true segment address of pointer and check for wrap around memory. }
function PtrSeg(Ptr : pointer) : word;

var
PSeg : word; { True segment of pointer. }

begin
PSeg := Seg(Ptr^) + Ofs(Ptr^) shr 4;

if PSeg < Seg(Ptr^) then
{ Pointer points beyond standard 1M memory. }
PSeg := $FFFF;

PtrSeg := PSeg;
end;


{***}
{ Validate interrupt; make sure not beyond code space and not hijacked. }
function ValidateIntr(IntrNum : integer; MemLimit : word) : word;

var
Result : word; { Result of tests. }
I : record
case boolean of
false:
(
IPtr : pointer; { Interrupt pointer. }
);

true:
(
CodePtr : BytePtr; { Pointer to interrupt; treat as data. }
);
end;
ISeg : word; { Adjusted segment of I.IPtr. }
Target : pointer; { Target of hijacked interrupt. }
IntrMCB : MCBPtr; { MCB of hijacked interrupt. }
TargetMCB : MCBPtr; { MCB of target of hijacking. }

begin
{ Assume interrupt is valid. }
Result := StealthOK;

{ Get interrupt and adjusted segment. }
GetIntVec(IntrNum, I.IPtr);
ISeg := PtrSeg(I.IPtr);

{ Interrupt pointer invalid if between PSP and memory limit. }
if (ISeg >= PrefixSeg) and (ISeg < MemLimit) then
Result := Result or StealthIntrErr;

{ Check beginning of interrupt code for suspicious instructions. }
case I.CodePtr^ of
$EA, { JMP FAR . }
$9A: { CALL FAR . }
begin
Target := PtrPtr(longint(I.CodePtr) + 1)^;
Result := Result or StealthDOSHijacked;
end;

$2E: { CS segment prefix. }
case WordPtr(longint(I.CodePtr) + 1)^ of
$2EFF, { JMP FAR CS:[addr]. }
$1EFF: { CALL FAR CS:[addr]. }
begin
Target := PtrPtr(Ptr(Seg(I.CodePtr^), WordPtr(longint(I.CodePtr) + 3)^))^;
Result := Result or StealthDOSHijacked;
end;
end;
end;

if Result and StealthDOSHijacked <> 0 then
begin
{ Determine MCB's that own the interrupt and the target of the redirection. }
IntrMCB := MCBOwner(I.CodePtr);
TargetMCB := MCBOwner(Target);

{ Redirection is valid if it falls within the same MCB or falls outside memory limit. }
if (IntrMCB = TargetMCB) or (PtrSeg(target) >= MemLimit) then
Result := Result and not StealthDOSHijacked;
end;

ValidateIntr := Result;
end;


{***}
{ Perform anti-virus system check. }
function StealthSysCheck : word;

var
Result : word; { Result of tests. }
MCB : MCBPtr; { Memory control block pointer. }
BIOSMem : word; { Memory in paragraphs according to BIOS. }
DOSMem : word; { Memory in paragraphs according to DOS. }
MemLimit : word; { Limit of useable memory. }

begin
{ Assume system passes all tests. }
Result := StealthOK;

BIOSMem := BIOSMemory * 64;

{ Find last memory control block. }
MCB := GetMCB;
while MCB^.ID <> $5A do
MCB := NextMCB(MCB);

DOSMem := Seg(MCB^) + MCB^.Size + 1;

{ DOS memory extenders may show more memory than BIOS and some versions of DOS may differ by up to 1k from BIOS memory. }
if BIOSMem > DOSMem + 64 then
Result := Result or StealthDOSMemErr;

{ Assume BIOS memory goes at least to 640k limit (may have been modified by virus). }
if BIOSMem < $A000 then
MemLimit := $A000
else
MemLimit := BIOSMem;
if MemLimit < DOSMem then
MemLimit := DOSMem;

{ Swap vectors taken over by Turbo Pascal. }
SwapVectors;

Result := Result or ValidateIntr($21, MemLimit); { DOS function interrupt. }
Result := Result or ValidateIntr($24, MemLimit); { Critical error interrupt. }
Result := Result or ValidateIntr($25, MemLimit); { Absolute disk read interrupt. }
Result := Result or ValidateIntr($26, MemLimit); { Absolute disk write interrupt. }
Result := Result or ValidateIntr($1C, MemLimit); { User timer interrupt. }
Result := Result or ValidateIntr($28, MemLimit); { DOS OK interrupt. }

{ Restore vectors required by Turbo Pascal. }
SwapVectors;

StealthSysCheck := Result;
end;


{***}
{ Extract the low word of a dword. }
function LowW(DWord : longint) : word;

begin
LowW := DWordRec(DWord).Lo;
end;


{***}
{ Extract the high word of a dword. }
function HiW(DWord : longint) : word;

begin
HiW := DWordRec(DWord).Hi;
end;


{***}
{ Calculate the CRC of a file. The file is assumed to be open and the buffer is assumed to be valid. }
function CalcCRC(var F : file; Buffer : BytePtr; BufSize : word; Polynomial : crc32_t) : crc32_t;

var
Table : array [0 .. 255] of crc32_t; { CRC table. }
I : word; { Byte counter. }
HalfI : ^crc32_t; { Pointer to CRC of I div 2. }
CRC : crc32_t; { Current CRC. }
BufPtr : BytePtr; { Pointer to walk through Buffer. }

begin
{ Generate a CRC lookup table for faster calculation. }
I := 0;
HalfI := @Table[0];
Table[0] := 0;
while I < 256 do
begin
if Hi(HiW(HalfI^)) and $80 <> $00 then
begin
Table[I + 1] := HalfI^ shl 1;
Table[I] := Table[I + 1] xor Polynomial;
end
else
begin
Table[I] := HalfI^ shl 1;
Table[I + 1] := Table[I] xor Polynomial;
end;

Inc(I, 2);
Inc(longint(HalfI), sizeof(crc32_t));
end;

{ Calculate CRC. }
CRC := 0;
BlockRead(F, Buffer^, BufSize, I);
while I <> 0 do
begin
BufPtr := Buffer;
while I <> 0 do
begin
CRC := (CRC shl 8) xor Table[Hi(HiW(CRC)) xor BufPtr^];

Dec(I);
Inc(longint(BufPtr));
end;

BlockRead(F, Buffer^, BufSize, I);
end;

CalcCRC := CRC;
end;


{***}
{ Check file header consistency and calculate CRC of file. }
function StealthFileCheck(FileName : PathStr; FCRC : FileCRC) : word;

var
Result : word; { Result of tests. }

FN : PathStr; { Complete file name with path. }
Dir : DirStr; { Directory of ParamStr(0). }
Name : NameStr; { Name of ParamStr(0). }
Ext : ExtStr; { Extension of ParamStr(0). }

DirInfo : SearchRec; { File directory information. }
TimeStamp : DateTime; { Time stamp within DirInfo. }

OldFileMode : byte; { Old file open mode. }
F : file; { File handle for FN. }

Buffer : BytePtr; { Buffer for file's data. }
BufSize : word; { Buffer size. }

begin
{ Assume file passes all tests. }
Result := StealthOK;

{ If name contains drive or directory, use unmodified, else build full name. }
if (FileName[2] = ':') or (Pos('\', FileName) <> 0) then
FN := FileName
else
begin
{ Assume file not found. }
FN := '';

{ DOS version 3 and above save program name in ParamStr(0). }
if Lo(DOSVersion) >= 3 then
begin
{ Split program name into its components. }
FN := ParamStr(0);
FSplit(FN, Dir, Name, Ext);

{ Merge drive and directory with file name. }
FN := Dir + FileName;

{ Attempt to access file; if failed, pass control onto path search. }
FindFirst(FN, ReadOnly or Hidden or SysFile or Archive, DirInfo);
if DosError <> 0 then
FN := '';
end;
end;

if FN = '' then
{ Search path for file. }
FN := FSearch(FileName, GetEnv('PATH'));

if FN <> '' then
begin
FindFirst(FN, ReadOnly or Hidden or SysFile or Archive, DirInfo);
if DosError = 0 then
begin
UnpackTime(DirInfo.Time, TimeStamp);

{ Check file time, day, and year. }
if (TimeStamp.Sec > 59) or (TimeStamp.Min > 59) or (TimeStamp.Hour > 23) or
(TimeStamp.Day = 0) or (TimeStamp.Year >= 2080) then
Result := Result or StealthFileDateErr;

case TimeStamp.Month of
4, 6, 9, 11:
{ Thirty days hath September, April, June, and November. }
if TimeStamp.Day > 30 then
Result := Result or StealthFileDateErr;

1, 3, 5, 7, 8, 10, 12:
{ All the rest have thirty-one, excepting February alone. }
if TimeStamp.Day > 31 then
Result := Result or StealthFileDateErr;

2:
{ February hath twenty-eight days clear, and twenty-nine in each leap year. }
if TimeStamp.Year mod 4 <> 0 then
begin
if TimeStamp.Day > 28 then
Result := Result or StealthFileDateErr;
end
else
if TimeStamp.Day > 29 then
Result := Result or StealthFileDateErr;

else
Result := Result or StealthFileDateErr;
end;

{ Save and set file mode to read-only. }
OldFileMode := FileMode;
FileMode := 0;

Assign(F, FN);
Reset(F, 1);

{ Restore file mode. }
FileMode := OldFileMode;

if IOResult = 0 then
begin
{ Compare length to length returned by directory search. }
if FileSize(F) <> DirInfo.Size then
Result := Result or StealthFileSizeErr;

{ Make sure that polynomial has its last bit and at least one other set. }
if (FCRC.Polynomial and $00000001 = 0) or (FCRC.Polynomial = $00000001) then
Result := Result or StealthCRCBadPoly;

{ Allocate 16k buffer if possible, but get at least 512 bytes. }
BufSize := 16384;
Buffer := BufAlloc(BufSize, 512);

if Buffer <> nil then
begin
{ CRC is valid if calculated CRC matches what is stored in FCRC. }
if FCRC.CRC <> CalcCRC(F, Buffer, BufSize, FCRC.Polynomial) then
Result := Result or StealthCRCInvalid;

FreeMem(Buffer, BufSize);
end
else
Result := Result or StealthNoMem;

Close(F);
end
else
Result := Result or StealthFileErr;
end
else
Result := Result or StealthFileErr;
end
else
Result := Result or StealthFileErr;

StealthFileCheck := Result;
end;


end.


  3 Responses to “Category : Miscellaneous Language Source Code
Archive   : STLTH22.ZIP
Filename : VIRCHECK.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/