AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Dateien / Laufwerke Delphi Datei nach String durchsuchen

Datei nach String durchsuchen

Ein Thema von Matze · begonnen am 23. Mär 2005 · letzter Beitrag vom 3. Apr 2005
Antwort Antwort
Benutzerbild von Matze
Matze
(Co-Admin)

Registriert seit: 7. Jul 2003
Ort: Schwabenländle
14.929 Beiträge
 
Turbo Delphi für Win32
 
#1

Datei nach String durchsuchen

  Alt 23. Mär 2005, 11:56
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
  Mit Zitat antworten Zitat
Benutzerbild von Jens Schumann
Jens Schumann

Registriert seit: 27. Apr 2003
Ort: Bad Honnef
1.644 Beiträge
 
Delphi 2009 Professional
 
#2

Re: Datei nach String durchsuchen

  Alt 23. Mär 2005, 12:17
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.
I come from outer space to save the human race
  Mit Zitat antworten Zitat
CalganX

Registriert seit: 21. Jul 2002
Ort: Bonn
5.403 Beiträge
 
Turbo Delphi für Win32
 
#3

Re: Datei nach String durchsuchen

  Alt 3. Apr 2005, 10:34
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]
Angehängte Dateien
Dateityp: ppt boyer_moore_816.ppt (358,0 KB, 121x aufgerufen)
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:07 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz