*.txt Datei Durchsuchen !?!

[Zero]

Hallo ihr Leute...
Kann mir jemand einen tipp oder sogar ein Teil Quelltext geben... und zawar geht es darum. Es soll eine Textdatei nach einem Gewissen wort.. oder einem Satz durchsucht werden..

Hat da einer eine Idee..

Bin für jede art von Hilfe dankbar.

MfG
Zero

[Robert Marquardt]

Das Stichwort hierzu isr Boyer-Moore bzw Boyer-Moore-Horspool Algorithmus. Mit einer Google Suche "Boyer Moore Horspool Delphi Pascal" solltest du finden was du suchst

[Hagen Reddmann]

<pre>

function Find(SubStr,Text: PChar; SubStrLength,TextLength,StartPos: Integer): Integer;
var
Skips: array[Char] of Integer;
Chars: array[Char] of Char;
Pattern: String;
I: Integer;
P,T,E,N,M: PChar;
C: Char;
begin
if StartPos < 0 then StartPos := 0;
if (SubStrLength <= 0) or (SubStrLength > TextLength - StartPos) then
begin
Result := -1;
Exit;
end;

for C := Low(C) to High(C) do Chars[C] := C;
CharLowerBuff(@Chars, SizeOf(Chars));
for C := Low(Skips) to High(Skips) do
Skips[C] := SubStrLength;

SetString(Pattern, SubStr, SubStrLength);

P := PChar(Pattern);
CharUpperBuff(P, SubStrLength);
M := P;
for I := SubStrLength -1 downto 1 do
begin
Skips[M^] := I;
Inc(M);
end;
CharLowerBuff(P, SubStrLength);
M := P;
for I := SubStrLength -1 downto 1 do
begin
Skips[M^] := I;
Inc(M);
end;
C := M^;
Dec(SubStrLength);
T := Text + SubStrLength + StartPos;
E := Text + TextLength;

while T < E do
if C <> Chars[T^] then Inc(T, Skips[T^]) else
begin
N := T;
M := P + SubStrLength;
repeat
if M = P then
begin
Result := T - Text - SubStrLength;
Exit;
end;
Dec(M);
Dec(N);
until M^ <> Chars[N^];
Inc(N, Skips[N^]);
Inc(T, Skips[T^]);
if T < N then T := N;
end;

Result := -1;
end;

function FindCase(SubStr,Text: PChar; SubStrLength,TextLength,StartPos: Integer): Integer;
var
Skips: array[Char] of Integer;
I: Integer;
T,E,N,M: PChar;
C: Char;
begin
if StartPos < 0 then StartPos := 0;
if (SubStrLength <= 0) or (SubStrLength > TextLength - StartPos) then
begin
Result := -1;
Exit;
end;

for C := Low(Skips) to High(Skips) do
Skips[C] := SubStrLength;

Dec(SubStrLength);

M := SubStr;
for I := SubStrLength downto 1 do
begin
Skips[M^] := I;
Inc(M);
end;
C := M^;
T := Text + SubStrLength + StartPos;
E := Text + TextLength;

while T < E do
if C <> T^ then Inc(T, Skips[T^]) else
begin
N := T;
M := SubStr + SubStrLength;
repeat
if M = SubStr then
begin
Result := T - Text - SubStrLength;
Exit;
end;
Dec(M);
Dec(N);
until M^ <> N^;
Inc(N, Skips[N^]);
Inc(T, Skips[T^]);
if T < N then T := N;
end;

Result := -1;
end;

function StrPos(const SubStr, Text: String; StartPos: Integer; CaseInsensitive: Boolean): Integer;
begin
Inc(StartPos);
if CaseInsensitive then Result := Find(PChar(SubStr), PChar(Text), Length(SubStr), Length(Text), StartPos)
else Result := FindCase(PChar(SubStr), PChar(Text), Length(SubStr), Length(Text), StartPos);
Inc(Result);
end;

</pre&gt

[Hagen Reddmann]

obiger Source ist der Boyer-Moore-Horspool Algorithmus.
StrPos() kann die System Funktion Pos() ersetzen, mit dem Unterschied das man auch ohne Berücksichtung der Groß/Kleinschreibweise suchen kann und das man eine Start Position im Text vorgibt.
Verzeih, aber ich habe den Code in Find() und FindCase() nicht auf Leserlichkeit sondern auf Geschwindigkeit getrimmt.<br>

Im Grunde versucht man z.B. beim Suchsatz "Dies ist ein Test" nicht immer ALLE zeichen zu vergleichen, sondern im Bestcase wird nur jedes 17'te Zeichen des Textes verglichen, man überspringt also ca. 16 Zeichen auf einmal mit nur einem zeichenvergleich. D.h. auch das der Boyer More mit längeren Suchtexten immer um ein Vielfaches schneller als z.B. Pos() ist.<br>

Nun, brauchst Du noch ein Memory Mapped File um die Textdatei zu öffnen.

<pre>

function Scan(const FileName,Pattern: String; CaseInsensitive: Boolean): Boolean;
var
FHandle,FMapping: THandle;
FMemory: Pointer;
FPos,FSize: Integer;
FCount: Integer;
FPlaces: array of Cardinal;
begin
Result := False;
FPos := -1;
FCount := 0;
FHandle := FileOpen(FileName, fmOpenRead or fmShareDenyNone);
if FHandle > 0 then
try
FSize := GetFileSize(FHandle, nil);
if FSize > 0 then
begin
FMapping := CreateFileMapping(FHandle, nil, PAGE_READONLY or SEC_COMMIT, 0, 0, nil);
if FMapping <> 0 then
try
FMemory := MapViewOfFile(FMapping, FILE_MAP_READ, 0, 0, 0);
if FMemory <> nil then
try
try
repeat
if CaseInsensitive then
FPos := Find(PChar(Pattern), FMemory, Length(Pattern), FSize, FPos +1)
else
FPos := FindCase(PChar(Pattern), FMemory, Length(Pattern), FSize, FPos +1);
if FPos < 0 then Break;
if FCount and 255 = 0 then SetLength(FPlaces, FCount +256);
FPlaces[FCount] := FPos;
Inc(FCount);
until False;
SetLength(FPlaces, FCount);
Result := FCount > 0;
// FPlaces[] enthält nun die Positionen aller gefundenen Texte
// FCount enthält die Anzahl der gefundenen Patterns
except
FCount := 0;
end;
finally
UnmapViewOfFile(FMemory);
end;
finally
CloseHandle(FMapping);
end;
end;
finally
FileClose(FHandle);
end;
end;

</pre>

Hage

[Hagen Reddmann]

Übrigens im WEB findet man einige andere PASCAL Umsetzungen, z.B. efg.com, allerdings funktionieren die meisten im Falle der Nichtberücksichtigung der Groß/Kleinschreibung nicht korrekt

[Hagen Reddmann]

meine test ergaben das auf meinem PIV 1.5GHz ca. 25Mb pro Sekunde gescannt werden können

[Zero]

Hey Leute erstmal fielen dank für die mühe mit dem Quelltext usw. Kann mir jetzt noch jemand helfen, wie ich das am besten verarbeite.. ist schon klar funktion, werte übergeben usw.. aber wie setzte ich dieses jetzt um

[Alex]

Hallo,<br>ich habs nicht ausprobiert, doch ich denke du musst nur die Funktionen in eine Unit kopieren und dann Scan aufrufen und zwar mit den entsprechenden Parametern. Sprich als erstes den Dateinamen angeben, für die Datei, die durchsucht werden soll und dann den Suchtext sowie true oder false, je nach dem ob CaseInsensitive oder nicht

[Zero]

Ja das habe ich mir auch so gedacht.. nur wie bzw. wo bekomme ich die Ausgabe ?

MfG Zer

[Alex]

Hallo,<br>
function Scan(const FileName,Pattern: String; CaseInsensitive: Boolean): Boolean; <br>
...<br>
// FPlaces[] enthält nun die Positionen aller gefundenen Texte <br>
// FCount enthält die Anzahl der gefundenen Patterns <br>
...<br>
end; <br&gt

[Zero]

Stimmt... bin wohl nicht ganz bei der Sache.. habe ich übersehn... Besten Dank..

Gruss Zer

[Hagen Reddmann]

Der Code stammt eigentlich aus einer Object Implementierung. Die Methode Scan gehört zu einem TSearchedFile Object, das sozusagen einen Dateinamen und alle Positionen des gefundenen Patterns enthält. Solche Objecte werden dann von einem übergeordenten Thread Object in einer Liste verwaltet. Das Thread Object wiederum scant nun alle Dateien in einem Pfad + eventl. SubDirs und erzeugt TSearchedFile Objecte. Falls dieses das Pattern enthält, also FCount > 0 ist, dann wird es in die Liste im ThreadObject eingefügt, ansonsten wird es wieder zerstört. Das Thread Object selber informiert über Events das Formular oder was auch immer. In meinem Falle wurde eine Liste aktualisiert und beim Click in die Liste wird in einem HEX-View, auschnittsweise alle gefundenen Patterns der Datei angezeigt.<br>
Das erklärt warum FCount,FPlaces[] nicht als Parameter existieren, da sie eigentlich Member eines Objectes waren.<br>

Zurück zum Suchalgorithmus: Eine interessante Frage die ich da hätte wäre der Fall wie man sehr effizient den Boyer-Moore umstrickt damit man gleichzeitigt mehrere Suchbegriffe suchen kann, inclusive Suchmuster die man ausschließen möchte oder Nährungsweise Suche (s.ä. wie Soundex etc). Falls da jemand gute Denkansätz hätte wäre es interessant darüber zu diskutieren.
Jedenfalls wäre ein superschneller, scriptbasierender Such/Musteralgorithmus sehr sehr reizvoll. Ich denke da an sowas wie die Suchscripts im WEB Browser.

Gruß Hage

[Zero]

Ja das stimmt wohl man müsste sich mal mehr damit beschäftigen....

[Andreas Kosch]

Hallo,

wir leben in einer objektorientierten Welt. Warum alles selbst nochmals programmieren, wenn das Betriebssystem so etwas schon kann. Wenn auf dem Windows-Rechner der Indexdienst läuft, darf man über ADO (ActiveX Data Objects) oder über die ADO Express-Komponenten von Delphi eine SELECT-Abfrage auf das Dateisystem der Festplatte absetzen. Die folgende Abfrage liefert unabhängig von der Anzahl der zu durchsuchenden Dateien das Ergebnis in Bruchteilen einer Sekunde zurück:
<pre>
SELECT Directory,Filename,Size,Create
FROM SCOPE()
WHERE CONTAINS (Contents,'Suchbegriff')
</pre>
Wenn der OLE DB Provider <b>MSIDXS</b> (OLE DB Provider for Indexing Service) eingebunden wird, liefert die Funktion <b>SCOPE</b> alle vorgefundenen Festplatten als virtuelle Tabelle zurück.

Da der Indexdienst in seinem Volltextkatalog auch die Position der Wörter in der Datei speichert, kann man über NEAR auch nach mehreren Begriffen suchen, in nahe beisammen in der Datei vorkommen:
<pre>
SELECT Directory,Filename,Size,Create
FROM SCOPE()
WHERE CONTAINS (Contents,'Suchbegriff1 NEAR Suchbegriff2')
</pre>
&#10

[Zero]

Auch nicht schlecht !

gruss Zer