(***************************************************************************)
(* Stringsuche in Anlehnung an Boyer Moore *)
(***************************************************************************)
(* 1.0 Adaption an 32-Bit Pascal 2000/06/23*)
(***************************************************************************)
unit boymoore32;
interface
{Alle String-Typen sind klassische Pascal-Strings: Array [0..255] of char!}
{Dies entspricht unter Delphi dem shortstring mit der Definition ist man auf der sicheren Seite}
{Der Array in dem gesucht wird ist 64K groß (noch) }
{ Die "alten" Typen word etc werden noch an 32-Bit Gepflogenheiten angepasst}
{ !!!! Es gibt nur einen Sucharray !!! }
type
sucharraytyp=
packed array [0..255]
of byte;
{packed um Lücken zu vermeiden}
var
sucharray : sucharraytyp;
function INITSUCHARR(suchstring:shortstring):boolean;
(* die 16-Bit version arbeitet mit 16Bit Wörtern
function FINDESTR(sptr:pointer;slang:word;suchstring:shortstring):word;
die 32-Bit Version mit 32-Bit Integern*)
function FINDESTR(bptr:pointer;blang:integer;suchstring:shortstring):integer;
implementation
function INITSUCHARR(suchstring:shortstring):boolean;
var
j : word;
begin
{----- jedem ASCII-Wert die Länge des suchstr zuweisen ------------}
fillchar(sucharray,sizeof(sucharray),length(suchstring));
{---- umgekehrt indizieren n...1 !!!!! ----------------------------}
if length(suchstring)>0
then begin
INITSUCHARR:=true;
for j:=1
to length(suchstring)
do begin
sucharray[byte(suchstring[j])]:=length(suchstring)-j;
sucharray[byte(suchstring[j])]:=sucharray[byte(suchstring[j])];
end;
end
else
INITSUCHARR:=false;
end;
function FINDESTR(bptr:pointer;blang:integer;suchstring:shortstring):integer;
type
srt =packed
array [1..$FFFF]
of byte;
srtc=packed
array [1..$FFFF]
of char;
{ fürs debugging }
var
bi : integer;
{ Index des Source Integer für 32Bit!}
ssi : integer;
{ Index Suchstr Integer für 32Bit!}
ssl : integer;
{ Länge suchstr Integer für 32Bit!}
begin
ssl:=length(suchstring);
if ssl>blang
then { Source ist zu klein }
FINDESTR:=-1
{ nicht gefunden }
else begin
bi :=ssl;
{ erste Vergleichspos ist ende SuchS }
ssi:=ssl;
repeat
if sucharray[srt(bptr^)[bi]]>0
then
inc(bi,sucharray[srt(bptr^)[bi]])
else begin
ssi:=ssl;
repeat
dec(bi,1);
dec(ssi,1);
until (ssi<1)
or (srt(bptr^)[bi]<>byte(suchstring[ssi]));
if ssi>0
then
inc(bi,ssl-(ssi-1));
end;
until (bi>blang)
or (ssi<1);
{ Ergebnis für 0-Basierte Arrays}
if ssi<1
then FINDESTR:=bi
else FINDESTR:=-1;
end;
end;
end.