home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
TCSEL002
/
BMSRCH.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-10-20
|
4KB
|
103 lines
{$A+,B-,D-,E+,F-,I-,L-,N-,O-,R-,S-,V-}
unit BMSrch;
interface
type
Btable = array[0..255] of byte;
procedure BMMakeTable(var s; var t : Btable);
function BMSearch(var buff; size : word; Bt: Btable; var st): word;
function BMSearchUC(var buff; size : word; Bt: Btable; var st): word;
implementation
procedure BMMakeTable(var s; var t : Btable);
{ Makes a Boyer-Moore search table. s = the search string t = the table }
var
st : Btable absolute s;
slen: byte absolute s;
x : byte;
begin
FillChar(t,sizeof(t),slen);
for x := slen downto 1 do
if (t[st[x]] = slen) then
t[st[x]] := slen - x
end;
function BMSearch(var buff; size : word; Bt: Btable; var st): word;
{ Not quite a standard Boyer-Moore algorithm search routine }
{ To use: pass buff as a dereferenced pointer to the buffer}
{ st is the string being searched for }
{ size is the size of the buffer }
{ If st is not found, returns $ffff }
var
buffer : array[0..65519] of byte absolute buff;
s : array[0..255] of byte absolute st;
len : byte absolute st;
s1 : string absolute st;
s2 : string;
numb,
x : word;
found : boolean;
begin
s2[0] := chr(len); { sets the length to that of the search string }
found := false;
numb := pred(len);
while (not found) and (numb < (size - len)) do begin
if buffer[numb] = ord(s1[len]) then { partial match } begin
if buffer[numb-pred(len)] = ord(s1[1]) then { less partial! } begin
move(buffer[numb-pred(len)],s2[1],len);
found := s1 = s2; { if = it is a complete match }
BMSearch := numb - pred(len); { will stick unless not found }
end;
inc(numb); { bump by one char - match is irrelevant }
end
else
inc(numb,Bt[buffer[numb]]);
end;
if not found then
BMSearch := $ffff;
end; { BMSearch }
function BMSearchUC(var buff; size : word; Bt: Btable; var st): word;
{ Not quite a standard Boyer-Moore algorithm search routine }
{ To use: pass buff as a dereferenced pointer to the buffer}
{ st is the string being searched for }
{ size is the size of the buffer }
{ If st is not found, returns $ffff }
var
buffer : array[0..65519] of byte absolute buff;
chbuff : array[0..65519] of char absolute buff;
s : array[0..255] of byte absolute st;
len : byte absolute st;
s1 : string absolute st;
s2 : string;
numb,
x : word;
found : boolean;
begin
s2[0] := chr(len); { sets the length to that of the search string }
found := false;
numb := pred(len);
while (not found) and (numb < (size - len)) do begin
if UpCase(chbuff[numb]) = s1[len] then { partial match } begin
if UpCase(chbuff[numb-pred(len)]) = s1[1] then { less partial! } begin
move(buffer[numb-pred(len)],s2[1],len);
for x := 1 to length(s2) do
s2[x] := UpCase(s2[x]);
found := s1 = s2; { if = it is a complete match }
BMSearchUC := numb - pred(len); { will stick unless not found }
end;
inc(numb); { bump by one char - match is irrelevant }
end
else
inc(numb,Bt[ord(UpCase(chbuff[numb]))]);
end;
if not found then
BMSearchUC := $ffff;
end; { BMSearchUC }
end.