What's incorrect with this

[mohfa]

Thank you omata , if you have downloaded the Attachment you will see :

FastPos is function declared in FastStrings Unit Copyrighted by Peter Morris . and here is it declaration :

function FastPos(const aSourceString, aFindString : string; const aSourceLen, aFindLen, StartPos : Integer) : Integer; And Here is the Declaration of FindText :

Delphi-Quellcode:

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;

Any way here is the whole Unit Scanner.pas :

Delphi-Quellcode:

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.