unit BoyerMoore;
{$STRINGCHECKS OFF}
interface
uses
SysUtils;
type
TDirection = (dForward = 1, dBackward = -1);
TBoyerMoore =
class
strict private
FPattern :
String;
FPatternLen : Integer;
FDir : TDirection;
FBadTable :
array[0..65535]
of Integer;
// Größe entspricht gewünschtem Alphabet
FGoodTable :
array of Integer;
public
function PosBM(
const Pattern, Text:
String; Offset : Integer = 1;
const Dir : TDirection = dForward): Integer;
register;
end;
implementation
{ TBoyerMoore }
// *************
// P o s B M
// *************
//
// Boyer-Moore Stringsuche
//
// Eingabe:
// --------
// Pattern: Suchtext
// Text: Text, der durchsucht wird.
// Offset: Position ab der gesucht werden soll.
// Dir: Richtung in die gesucht werden soll: dForward = vorwärts dBackward = rückwärts
//
// Rückgabe:
// ---------
// =0: kein Match
// >0: Position des ersten Match
//
function TBoyerMoore.PosBM(
const Pattern, Text:
String; Offset: Integer;
const Dir: TDirection): Integer;
register;
var
i, j, k, iDir, iTLen, iOffCorr, iBadSkip : Integer;
bMatch : Boolean;
pcPattern, pcSuffix, pcPattFirst, pcText : PChar;
begin
Result := 0;
iTLen := Length(Text);
iDir := Ord(Dir);
// Good- und Bad-Table nur neu erzeugen, wenn neues Suchmuster verwendet wird
// oder die Suchrichtung wechselt.
if (FPattern <> Pattern)
or (FDir <> Dir)
then
begin
// Bad-Table der letzten Suche wieder auf 0 setzen
pcPattern := PChar(Pointer(FPattern));
// Pattern der vorhergehenden Suche
pcPattFirst := pcPattern;
while pcPattern - pcPattFirst < FPatternLen
do
begin
FBadTable[Ord(pcPattern^)] := 0;
Inc(pcPattern);
end;
FPatternLen := Length(Pattern);
// neue Patternlänge merken
SetLength(FGoodTable, FPatternLen);
// Sprungtabellen abhängig von der Suchrichtung erzeugen
case Dir
of
dForward:
begin
// Bad-Character-Table vorwärts
pcPattern := PChar(Pointer(Pattern));
i := 1;
while i <= FPatternLen
do
begin
FBadTable[Ord(pcPattern^)] := - i;
// FPatternLen später addieren
Inc(pcPattern);
Inc(i);
end;
// Good-Suffix-Table vorwärts
j := 1;
i := FPatternLen - 1;
// Initialisierung für Good-Table vorwärts
k := 0;
bMatch := False;
while j < FPatternLen
do
begin
while (i > 0)
and (k < j)
do
begin
if (i - k > 0)
then
begin
pcPattern := @Pattern[FPatternLen - k];
pcSuffix := @Pattern[i - k];
while (k < j)
and (i - k > 0)
and (pcPattern^ = pcSuffix^)
do
begin
bMatch := True;
inc(pcPattern);
inc(pcSuffix);
inc(k);
end;
end;
if (k < j)
then // kein ganzes Suffix gefunden
begin
if (i - k <= 0)
then // Ende erreicht, Rest mit MaxSkip füllen
i := 0
// Maximal-Skip
else
begin
if bMatch
then // kein Match mit dieser Länge...weitersuchen
begin
k := 0;
// wieder von vorn
bMatch := False;
end;
Dec(i);
end;
end;
end;
FGoodTable[j] := FPatternLen - i;
inc(j);
end;
end;
dBackward:
begin
// Bad-Character-Table rückwärts
pcPattern := @Pattern[FPatternLen];
i := FPatternLen;
while i > 0
do
begin
FBadTable[Ord(pcPattern^)] := i - 1 - FPatternLen;
// FPatternLen später wieder addieren
Dec(pcPattern);
Dec(i);
end;
// Good-Suffix-Table rückwärts
j := 1;
i := 1;
// Initialisierung für Good-Table rückwärts
k := 1;
bMatch := False;
while j < FPatternLen
do
begin
while (i < FPatternLen)
and (k - 1 < j)
do
begin
if (i + k < FPatternLen)
then
begin
pcPattern := @Pattern[k];
pcSuffix := @Pattern[i + k];
while (k - 1 < j)
and (i + k < FPatternLen)
and (pcPattern^ = pcSuffix^)
do
begin
bMatch := True;
inc(pcPattern);
inc(pcSuffix);
inc(k);
end;
end;
if (k - 1 < j)
then // kein ganzes Suffix gefunden
begin
if i + k > FPatternLen
then // Ende erreicht, Rest mit MaxSkip füllen
i := FPatternLen
// Maximal-Skip
else
begin
if bMatch
then // kein Match mit dieser Länge...weitersuchen
begin
k := 1;
// wieder von vorn
bMatch := False;
end;
Inc(i);
end;
end;
end;
FGoodTable[j] := i;
inc(j);
end;
end;
end;
FPattern := Pattern;
// Pattern merken
FDir := Dir;
// Richtung merken
end;
if (FPatternLen > iTLen)
or (FPatternLen * iTLen = 0)
or
(Offset = 0)
or (Offset > iTLen)
then
raise Exception.Create('
PosBM: Invalid parameter!');
Offset := Offset + (FPatternLen - 1) * iDir;
// Startoffset
case Dir
of
dForward:
iOffCorr := FPatternLen;
dBackward:
iOffCorr := 1;
end;
// Pattern in Text suchen
while (Offset <= iTLen)
and (OffSet > 0)
do
begin
pcPattern := @Pattern[iOffCorr];
pcText := @Text[Offset];
j := 0;
// Anzahl der Übereinstimmungen
while (j < FPatternLen)
and (pcText^ = pcPattern^)
do
begin
dec(pcPattern, iDir);
dec(pcText, iDir);
inc(j);
end;
if j < FPatternLen
then // Mismatch
begin
iBadSkip := FBadTable[Ord(pcText^)] + FPatternLen - j;
if iBadSkip > FGoodTable[j]
then
begin
inc(Offset, iBadSkip * iDir);
end
else
begin
inc(Offset, FGoodTable[j] * iDir);
end;
end
else // Match
Exit(Offset - iOffCorr + 1);
end;
end;
end.