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.