Datei nach String durchsuchen

[Matze]

Mit folgendem Code kann man Dateien nach einem bestimmten String durchsuchen lassen. Dani hat ihn hier gepostet.

Delphi-Quellcode:

function TForm1.ScanFileForString(aFile, SearchString: String; IgnoreCase: Boolean=true;
                           MaxBytesScanned: Int64 = 2097152): Boolean;
const 
  MAX_BUFFER_SIZE = 20480; //20 kb
var 
  Buffer: String;
  FS: TFileStream;
  BytesRead: Integer;
  i, match: Integer;
  BufferSize, StrLength: Integer;
begin
  Result := false;

  if (SearchString = '') then exit;
  if IgnoreCase then SearchString := ANSIUppercase(SearchString);

  //Datei öffnen... falls das nicht klappt gibts hier ne Exception
  //daher die Funktion besser im try..except Schutzblock aufrufen!
  FS := TFileStream.Create(aFile, fmOpenRead or fmShareDenyWrite);

  try
    BufferSize := 0;
    StrLength := Length(SearchString);
    //Ermitteln wie groß der Puffer sein muss. Er soll ca. 20 kb groß sein,
    //wenn nicht die ganze Datei reinpasst
    if FS.Size <= MAX_BUFFER_SIZE then
      BufferSize := FS.Size else
        BufferSize := (MAX_BUFFER_SIZE div StrLength) * StrLength;
    SetLength(Buffer, BufferSize);

    Repeat //Höchstens MaxBytesScanned Bytes untersuchen oder bis EOF
      BytesRead := FS.Read(Buffer[1], BufferSize);
      if BytesRead = 0 then exit;
      if IgnoreCase then Buffer := ANSIUppercase(Buffer);

      for i:=1 to BytesRead do
      begin
        if Abbruch then exit;
        Application.ProcessMessages;

        match := 0;
        if (BufferSize-(i-1) >= StrLength) then
          while (Buffer[i+match] = SearchString[match+1]) do
          begin
            if Abbruch then exit;
            Application.ProcessMessages;

            inc(match);
            If match = StrLength then
            begin
              Result := true;
              //exit;
            end;
          end;
      end;

    Until (FS.Position >= MaxBytesScanned) or (FS.Position = FS.Size);
  finally
    FS.Free;
    SetLength(Buffer, 0);
  end; 
end;

Suchwörter: Wort Worte finden suchen auflisten

[Jens Schumann]

Hallo,
ich behaupte das der Code einen Bug enthält.

Was passiert wenn die Mitte des gesuchten Strings auf der Buffersizegrenze liegt?

Dann wird beim ersten Read nur die erste Hälfte des gesuchten Strings eingelesen.
Folge: Der Srting wird nicht gefunden.

Beim zweiten Read wird die zweite Hälfte des gesuchten Strings eingelesen
Folge: Der Srting wird nicht gefunden.

[CalganX]

Von Jens Schumann kommt noch folgender weiterer Tipp (ist mir leider beim Teilen des Beitrages versehentlich abhanden gekommen):

Zitat:

Hallo,
ich schlage vor einen Text nach dem Boyer-Moore in einem Stream zu suchen.
Das geht auch wesentlich schneller als der o.g. Code.
Dafür habe ich mir mal eine Komponente gebastelt.

Delphi-Quellcode:

unit JsTextSearch;

interface

uses
  SysUtils, Classes, Dialogs;

type
  TJsTextSearchFoundEvent = procedure(Sender : TObject; Position : Integer; var Cancel : Boolean) of object;

  TJsTextSearchSkipTable = Array[0..255] of Byte;

  TJsTextSearch = class(TComponent)
  private
    { Private-Deklarationen }
    FText      : String;
    FOnFound   : TJsTextSearchFoundEvent;
    FStream    : TStream;
    FSkipTable : TJsTextSearchSkipTable;
    procedure InitSkipTable(var SkipTable: TJsTextSearchSkipTable; const SubStr: String);
    procedure Search(aStream: TStream; SkipTable: TJsTextSearchSkipTable;
                     const aText: String);
  protected
    { Protected-Deklarationen }
    procedure DoFound(Position : Integer; var Cancel : Boolean); virtual;
  public
    { Public-Deklarationen }
    property  Stream : TStream read FStream write FStream;
    procedure Execute;
  published
    { Published-Deklarationen }
    property Text    : String read FText write FText;
    property OnFound : TJsTextSearchFoundEvent read FOnFound write FOnFound;
  end;

procedure Register;

implementation

const
  iBufferSize = 4096;

procedure Register;
begin
  RegisterComponents('MyComps', [TJsTextSearch]);
end;

{ TJsTextSearch }

procedure TJsTextSearch.DoFound(Position: Integer; var Cancel : Boolean);
begin
  If Assigned(FOnFound) then
    FOnFound(Self,Position, Cancel);
end;

procedure TJsTextSearch.Execute;
begin
  InitSkipTable(FSkipTable,FText);
  Search(FStream,FSkipTable,FText);
end;

procedure TJsTextSearch.InitSkipTable(var SkipTable: TJsTextSearchSkipTable; const SubStr: String);
var
  iCnt : Integer;
begin
  FillChar(SkipTable,SizeOf(TJsTextSearchSkipTable),Length(SubStr));
  for iCnt := 1 to Length(SubStr) do
    SkipTable[Ord(SubStr[iCnt])]:=Length(SubStr)-(iCnt);
end;

procedure TJsTextSearch.Search(aStream: TStream; SkipTable: TJsTextSearchSkipTable; const aText: String);
{Diese procedure arbeitet nach dem Boyer/Moore Verfahren.
 Über Event OnFound (Parameter Position) wird mitgeteilt, ob der aText gefunden
 wurde. Achtung: Die Zählung beginnt bei 0.
 Für Boyer/Moore siehe Powerpointdatei
}
var
  CanCancel       : Boolean;
  HelpStr         : String;
  ReadLen         : Integer;
  TextLen         : Integer;
  SourcePos       : Integer;
  SubStrPos       : Integer;
  aBuffer         : Array[1..iBufferSize] of Char;
  ReadBufferCount : Integer;
  TestEndOfBuffer : String;
  A : Integer;
begin
  CanCancel:=False;
  ReadBufferCount:=0;
  TextLen:=Length(aText);
  ReadLen:=0;
  aStream.Seek(0,soFromBeginning);
  While aStream.Position<aStream.Size do
    begin
    A:=0;
    SourcePos:=TextLen;
    ReadLen:=aStream.Read(aBuffer,SizeOf(aBuffer));
    Repeat
      SubStrPos:=TextLen;
      Repeat
        If aBuffer[SourcePos]=aText[SubStrPos] then
          begin
          Dec(SourcePos);
          Dec(SubStrPos);
          end
            else
              begin
              // Hole den Sprungwert aus der Skiptabelle
              If SkipTable[Ord(aText[SubStrPos])]>SkipTable[Ord(aBuffer[SourcePos])] then
                SourcePos:=SourcePos+TextLen
                  else
                    SourcePos:=SourcePos+SkipTable[Ord(aBuffer[SourcePos])];
              {Wenn mehrmals derselbe Buchstabe in dem gesuchten Text vorkommt,
               kann es passieren, dass SourcePos nicht exakt auf ReadLen landet.
               Wenn der gesuchte Text dann den Block abschließt, wird der
               Text nicht gefunden. Dadurch das SourcePos nie größer wird als
               ReadLen muss hier mitgezählt werden, ob Source auf ReadLen
               gesetzt wurde.}
              If SourcePos>ReadLen then
                begin
                SourcePos:=ReadLen;
                Inc(A);
                end;
              SubStrPos:=TextLen;
              end;
      Until (SubStrPos=0) or (SourcePos>ReadLen) or (A=2);
      If SubStrPos=0 then // Text gefunden
        begin
        DoFound(ReadBufferCount*SizeOf(aBuffer)+SourcePos-ReadBufferCount*TextLen,CanCancel);
        // Überspringe das gefundene Wort in aBuffer
        // Da der gesuchte Text aber von rechts nach links über aBuffer
        // "gezogen" wird, muss, da SourcePos um TextLen verringert wurde
        // SourcePos jetzt um 2*TextLen erhöht werden. Dann würde das
        // gefundene Wort übersprungen und SourcePos genau TextLen Positionen
        // hinter das gefundenen Wort gesetzt.
        SourcePos:=SourcePos+2*TextLen;
        end;
      If CanCancel then
        Exit;
    Until (SourcePos>ReadLen) or (A=2); // Block ist abgearbeitet
    Inc(ReadBufferCount); // merke die Anzahl gelesenen Blöcke

    {wg. der Blockbearbeitung kann es passieren, dass der gesuchte Text
     zerschnitten wird. Deshalb wird aStream.Position um die Textlänge
     nach "links" geschoben.
     Wenn aber das gesuchte Wort and er
     Blockgrenze abschließt wird es zweimal gefunden. Deshalb
     darf die Position nur zurückgesetzt werden, wenn der
     gesuchte Text NICHT den Block abschließt und der Stream.Postion<
     als Stream.Size ist (Wenn Stream.Positon=Stream.Size ist handelt
     es sich um den letzten Block. Dann muss nix mehr verschoben werden !!!}



    TestEndOfBuffer:=Copy(aBuffer,ReadLen-TextLen+1,TextLen);
    If (TestEndOfBuffer<>aText) and (Stream.Position<Stream.Size) then
      aStream.Seek(-(TextLen),soFromCurrent);
    end; //  While aStream.Position<Filestream.Size do
end;

end.

Ich habe die Komponente intensiv getestet. Mir sind bislang keine Fehler aufgefallen

Er hat in einer PowerPoint-Präsentation das Verfahren kurz vorgestellt. Zu finden ist diese Präsentation im Anhang.


[edit=Matze]Attachment hinzugefügt. MfG, Matze[/edit]