interface
unit Scanner;
interface
Function Search(
const AFilename:PChar;
Const AVirusName:PChar;
const ANameLength: integer;
Wnd, MsgID: integer): Boolean;
stdcall;
implementation
uses
SysUtils,
Classes,
Windows,
FastStrings;
const
BUF_SZ = 1024 *1000;
//1 MB
PROGRESS_MIN_STEPS = 5;
{$DEFINE USEWORKERS} //use TWorkerThreads
{$IFDEF USEWORKERS}
const
FWorker_Max = 9;
//!! TWorkerThread vars ( NO TOUCHING! )
// **********************************************************
var
FWorker_Buffers :
array[0..FWorker_Max]
of string;
FWorker_BufLen :
array[0..FWorker_Max]
of integer;
// **********************************************************
//!! TWorkerThread vars ( NO TOUCHING! )
//TWorkerThread...
//------pattern
function findtext(
const pattern:
string;
var delta:integer):
string;
var i,j:integer;
begin
i:=1;
while (i<=length(pattern))
and ((pattern[i]='
?')
or (pattern[i]='
*'))
do
inc(i);
j:=i;
delta:=j-1;
while (i<=length(pattern))
and (pattern[i]<>'
?')
and (pattern[i]<>'
*')
do
inc(i);
result:=copy(pattern, j, i-j);
end;
function Matches(
const AString, Pattern:
string; startpos:integer): boolean;
var
j, n, n1, n2: integer ;
p1, p2: pchar ;
label
match, nomatch;
begin
n1 := Length(AString) ;
n2 := Length(Pattern) ;
if n1 < n2
then
n := n1
else
n := n2;
p1 := pchar(AString) +startpos-1;
p2 := pchar(Pattern) ;
for j := 1
to n
do
begin
if p2^ = '
*'
then
goto match;
if (p2^ <> '
?')
and ( p2^ <> p1^ )
then
goto nomatch;
inc(p1) ; inc(p2) ;
end;
if n1 > n2
then
begin
goto match;
// we are searching for a match, not testing if the entire string matches the pattern
nomatch:
Result := False;
exit;
end else
if n1 < n2
then
begin
for j := n1 + 1
to n2
do
begin
if not ( p2^
in ['
*','
?'] )
then
goto nomatch ;
inc(p2) ;
end;
end;
match:
Result := True
end;
function patternPos(
const ASourceString, APatternString :
string; StartPos:integer):integer;
var l, ll,i,delta:integer;
p:
string;
begin
Assert(StartPos>0);
Assert(length(APatternString)>0);
result:=0;
l:=length(ASourceString);
if StartPos>l
then
exit;
p:=findText(APatternString, delta);
if p='
'
then
begin
if Matches(ASourceString, APatternString, StartPos)
then
result:=StartPos;
exit;
end else
begin
i:=StartPos-1;
ll:=length(p);
repeat
i:=FastPos(ASourceString, p, length(ASourceString), ll, i+1);
if i=0
then
exit;
if Matches(ASourceString, APatternString, i-delta)
then
begin
if APatternString[1]='
*'
then
result:=StartPos
else
result:=i-delta;
exit;
end;
until i=0;
end;
end;
type
TWorkerThread =
class(TThread)
private
FWaitEvent : THandle;
FDone : boolean;
FSearchResult : integer;
FTag : integer;
function _SignatureSearch(
const s:
string; sLen: integer): integer;
protected
procedure Execute;
override;
public
property WaitEvent: THandle
read FWaitEvent;
constructor Create;
destructor Destroy;
override;
property Done: boolean
read FDone
write FDone;
//returns the index of the virus
property SearchResult: integer
read FSearchResult
write FSearchResult;
property Tag: integer
read FTag;
end;
constructor TWorkerThread.Create;
begin
FWaitEvent := CreateEvent(
nil, false, false,
nil);
inherited Create(false);
FreeOnTerminate := true;
FDone := true;
FSearchResult := -1;
FTag := -1;
end;
destructor TWorkerThread.Destroy;
begin
CloseHandle(FWaitEvent);
inherited;
end;
//----------------------------------------------------------------------------//
//--------------- From Here i wanted to use WildCard -------------------------//
//----------------------------------------------------------------------------//
function TWorkerThread._SignatureSearch(
const s:
string; sLen: integer): integer;
var
lVirus: PVirusDefinition;
pattern :
string;
res : boolean;
i:integer;
AYes:Boolean;
begin
// AYes:=False;
result := -1;
lVirus := PVirusDefinition(gSignatures[0]);
pattern := '
';
while (lVirus <>
nil)
and (result < 0)
do begin
if lVirus^.Pattern = '
'
then begin
//no pattern
pattern := '
';
if ((FastPos( s,
lVirus^.Signature,
sLen,
lVirus^.SigLen, 1) > 0)
Or
(patternPos(s,lVirus^.Signature,1) > 0))
then
result := gSignatures.IndexOf(lVirus);
end else begin
if lVirus^.Pattern = pattern
then begin
//buffer contains pattern
if ((FastPos( s,
lVirus^.Signature,
sLen,
lVirus^.SigLen, 1) > 0)
Or
(patternPos(s,lVirus^.Signature,1) > 0))
then
result := gSignatures.IndexOf(lVirus);
end else begin
//new pattern
res := FastPos( s,
pattern,
sLen,
Length(pattern), 1) > 0;
if not res
then begin
//pattern not found so
//find next pattern...
lVirus := lVirus^.NextPattern;
continue;
end else begin
//pattern found
if ((FastPos( s,
lVirus^.Signature,
sLen,
lVirus^.SigLen, 1) > 0)
Or
(patternPos(s,lVirus^.Signature,1) > 0))
then
result := gSignatures.IndexOf(lVirus);
end;
end;
end;
lVirus := lVirus^.Next;
end;
end;
procedure TWorkerThread.Execute;
begin
while not Terminated
do begin
WaitForSingleObject(FWaitEvent, INFINITE);
ResetEvent(FWaitEvent);
if not Terminated
then begin
FDone := false;
if (FTag > -1)
and (FTag <= FWorker_Max)
then
FSearchResult := _SignatureSearch(FWorker_Buffers[FTag], FWorker_BufLen[FTag])
else
FSearchResult := -1;
FDone := true;
end;
end;
end;
//...TWorkerThread
var
FWorkers :
array[0..FWorker_Max]
of TWorkerThread;
Function Search(
const AFilename: PChar;
const AVirusName: PChar;
const ANameLength: integer;
Wnd, MsgID: integer): Boolean;
var
lStream: TStream;
lVirus: PVirusDefinition;
red : Integer;
sz : int64;
steps, totsteps : integer;
i, WorkerIndex : integer;
alldone : boolean;
begin
result := false;
if assigned(gSignatures)
then
begin
for i := 0
to FWorker_Max
do begin
if Length(FWorker_Buffers[i]) <> BUF_SZ
then
SetLength(FWorker_Buffers[i], BUF_SZ);
FWorker_BufLen[i] := 0;
FWorkers[i].FSearchResult := -1;
end;
try
lStream := TFileStream.Create(AFilename, fmOpenRead
or fmShareDenyNone);
try
sz := lStream.Size;
//calc total steps required
totsteps := 0;
repeat
Dec(sz, BUF_SZ);
Inc(totsteps);
if (sz > 0)
and (gMax_SigLen -1 > 0)
and (gMax_SigLen < BUF_SZ)
then
Inc(sz, gMax_SigLen);
until sz < 1;
steps := 0;
if (Wnd > 0)
and (MsgID > 0)
then
PostMessage(Wnd, MsgID, 0, 1);
try
//read buffer0
red := lStream.
Read(FWorker_Buffers[0][1], BUF_SZ);
if red > gMin_SigLen -1
then begin
//reposition file pointer
if (red = BUF_SZ)
and (gMax_SigLen -1 > 0)
and (gMax_SigLen < BUF_SZ)
then
lStream.Seek(-(gMax_SigLen -1), soFromCurrent);
FWorker_BufLen[0] := red;
FWorkers[0].Done := false;
SetEvent(FWorkers[0].WaitEvent);
while (red > 0)
and (red > gMin_SigLen -1)
and not result
do begin
//get next worker that is done
WorkerIndex := -1;
i := 0;
while (i <= FWorker_Max)
and (WorkerIndex < 0)
do begin
if FWorkers[i].Done
then
WorkerIndex := i;
Inc(i);
end;
if WorkerIndex > -1
then begin
if FWorkers[WorkerIndex].SearchResult > -1
then begin
//signature found...
lVirus := PVirusDefinition(gSignatures[FWorkers[WorkerIndex].SearchResult]);
StrPLCopy(AVirusName, lVirus^.
Name, ANameLength);
result := true;
end else begin
//read buffer
red := lStream.
Read(FWorker_Buffers[WorkerIndex][1], BUF_SZ);
//reposition file pointer
if (red = BUF_SZ)
and (gMax_SigLen -1 > 0)
and (gMax_SigLen < BUF_SZ)
then
lStream.Seek(-(gMax_SigLen -1), soFromCurrent);
FWorker_BufLen[WorkerIndex] := red;
Inc(steps);
if (Wnd > 0)
and (MsgID > 0)
and (totsteps >= PROGRESS_MIN_STEPS)
then
PostMessage(Wnd, MsgID, Round((steps/totsteps) *100), 1);
FWorkers[WorkerIndex].Done := false;
SetEvent(FWorkers[WorkerIndex].WaitEvent);
end;
end;
end;
//wait for all workers to finish
repeat
alldone := true;
i := 0;
while (i <= FWorker_Max)
and alldone
do begin
alldone := FWorkers[i].Done;
Inc(i);
end;
until alldone;
if not result
then begin
i := 0;
while (i <= FWorker_Max)
and not result
do begin
if FWorkers[i].SearchResult > -1
then begin
lVirus := PVirusDefinition(gSignatures[FWorkers[i].SearchResult]);
StrPLCopy(AVirusName, lVirus^.
Name, ANameLength);
result := true;
end;
Inc(i);
end;
end;
end;
finally
for i := 0
to FWorker_Max
do
FWorker_BufLen[i] := 0;
end;
if (Wnd > 0)
and (MsgID > 0)
and (totsteps >= PROGRESS_MIN_STEPS)
then
PostMessage(Wnd, MsgID, 100, 1);
finally
lStream.Free;
end;
except
// result about not accessable file??
raise EStreamError.Create('
Unable to open file');
end;
end;
end;
procedure InitWorkers;
var
i : integer;
begin
for i := 0
to FWorker_Max
do begin
SetLength(FWorker_Buffers[i], BUF_SZ);
FWorker_BufLen[i] := 0;
FWorkers[i] := TWorkerThread.Create;
FWorkers[i].FTag := i;
end;
end;
procedure KillTheWorkers;
var
i : integer;
begin
for i := 0
to FWorker_Max
do begin
FWorkers[i].Terminate;
SetEvent(FWorkers[i].WaitEvent);
end;
end;
initialization
InitWorkers;
finalization
KillTheWorkers;
{$ELSE} //no worker threads
var
Main_Buffer :
string;
Function Search(
const AFilename: PChar;
const AVirusName: PChar;
const ANameLength: integer;
Wnd, MsgID: integer): Boolean;
var
lStream: TStream;
lVirus: PVirusDefinition;
red : Integer;
sz : int64;
steps, totsteps : integer;
pattern :
string;
res : boolean;
begin
result := false;
if assigned(gSignatures)
then
begin
if Length(Main_Buffer) <> BUF_SZ
then //safety net
SetLength(Main_Buffer, BUF_SZ);
try
lStream := TFileStream.Create(AFilename, fmOpenRead
or fmShareDenyNone);
try
sz := lStream.Size;
//calc total steps required
totsteps := 0;
repeat
Dec(sz, BUF_SZ);
Inc(totsteps);
if (sz > 0)
and (gMax_SigLen -1 > 0)
and (gMax_SigLen < BUF_SZ)
then
Inc(sz, gMax_SigLen);
until sz < 1;
steps := 0;
if (Wnd > 0)
and (MsgID > 0)
then
PostMessage(Wnd, MsgID, 0, 1);
red := lStream.
Read(Main_Buffer[1], BUF_SZ);
while (red > 0)
and (red > gMin_SigLen -1)
do begin
Inc(steps);
if (Wnd > 0)
and (MsgID > 0)
and (totsteps >= PROGRESS_MIN_STEPS)
then
PostMessage(Wnd, MsgID, Round((steps/totsteps) *100), 1);
lVirus := PVirusDefinition(gSignatures[0]);
pattern := '
';
while (lVirus <>
nil)
and not result
do begin
if lVirus^.Pattern = '
'
then begin
//no pattern
pattern := '
';
result := FastPos( Main_Buffer,
lVirus^.Signature,
red,
lVirus^.SigLen, 1) > 0;
end else begin
if lVirus^.Pattern = pattern
then begin
//buffer contains pattern
result := FastPos( Main_Buffer,
lVirus^.Signature,
red,
lVirus^.SigLen, 1) > 0;
end else begin
//new pattern
pattern := lVirus^.Pattern;
res := FastPos( Main_Buffer,
pattern,
red,
Length(pattern), 1) > 0;
if not res
then begin
//pattern not found so
//find next pattern...
lVirus := lVirus^.NextPattern;
continue;
end else begin
//pattern found
result := FastPos( Main_Buffer,
lVirus^.Signature,
red,
lVirus^.SigLen, 1) > 0;
end;
end;
end;
if result
then begin
StrPLCopy(AVirusName, lVirus^.
Name, ANameLength);
exit;
end;
lVirus := lVirus^.Next;
end;
//reposition file pointer
if (red = BUF_SZ)
and (gMax_SigLen -1 > 0)
and (gMax_SigLen < BUF_SZ)
then
lStream.Seek(-(gMax_SigLen -1), soFromCurrent);
red := lStream.
Read(Main_Buffer[1], BUF_SZ);
end;
if (Wnd > 0)
and (MsgID > 0)
and (totsteps >= PROGRESS_MIN_STEPS)
then
PostMessage(Wnd, MsgID, 100, 1);
finally
lStream.Free;
end;
except
// result about not accessable file??
raise EStreamError.Create('
Unable to open file');
end;
end;
end;
{$ENDIF}
end.