home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / findrepl.swg / 0003_BMSRCH.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  103 lines
  1. {$A+,B-,D-,E+,F-,I-,L-,N-,O-,R-,S-,V-}
  2. Unit BMSrch;
  3.  
  4. Interface
  5.  
  6. Type
  7.   Btable = Array[0..255] of Byte;
  8.  
  9. Procedure BMMakeTable(Var s; Var t : Btable);
  10. Function BMSearch(Var buff; size : Word; Bt: Btable; Var st): Word;
  11. Function BMSearchUC(Var buff; size : Word; Bt: Btable; Var st): Word;
  12.  
  13. Implementation
  14.  
  15. Procedure BMMakeTable(Var s; Var t : Btable);
  16.   { Makes a Boyer-Moore search table. s = the search String t = the table }
  17.   Var
  18.     st  : Btable Absolute s;
  19.     slen: Byte Absolute s;
  20.     x   : Byte;
  21.   begin
  22.     FillChar(t,sizeof(t),slen);
  23.     For x := slen downto 1 do
  24.       if (t[st[x]] = slen) then
  25.         t[st[x]] := slen - x
  26.   end;
  27.  
  28. Function BMSearch(Var buff; size : Word; Bt: Btable; Var st): Word;
  29.   { Not quite a standard Boyer-Moore algorithm search routine }
  30.   { To use:  pass buff as a dereferenced Pointer to the buffer}
  31.   {          st is the String being searched For              }
  32.   {          size is the size of the buffer                   }
  33.   { If st is not found, returns $ffff                         }
  34.   Var
  35.     buffer : Array[0..65519] of Byte Absolute buff;
  36.     s      : Array[0..255] of Byte Absolute st;
  37.     len    : Byte Absolute st;
  38.     s1     : String Absolute st;
  39.     s2     : String;
  40.     numb,
  41.     x      : Word;
  42.     found  : Boolean;
  43.   begin
  44.     s2[0] := chr(len);       { sets the length to that of the search String }
  45.     found := False;           
  46.     numb := pred(len);
  47.     While (not found) and (numb < (size - len)) do begin
  48.       if buffer[numb] = ord(s1[len]) then { partial match } begin
  49.         if buffer[numb-pred(len)] = ord(s1[1]) then { less partial! } begin
  50.           move(buffer[numb-pred(len)],s2[1],len);
  51.           found := s1 = s2;                   { if = it is a complete match }
  52.           BMSearch := numb - pred(len);       { will stick unless not found }
  53.         end;
  54.         inc(numb);                 { bump by one Char - match is irrelevant }
  55.       end
  56.       else
  57.         inc(numb,Bt[buffer[numb]]);
  58.     end;
  59.     if not found then
  60.       BMSearch := $ffff;
  61.   end;  { BMSearch }
  62.  
  63.  
  64. Function BMSearchUC(Var buff; size : Word; Bt: Btable; Var st): Word;
  65.   { Not quite a standard Boyer-Moore algorithm search routine }
  66.   { To use:  pass buff as a dereferenced Pointer to the buffer}
  67.   {          st is the String being searched For              }
  68.   {          size is the size of the buffer                   }
  69.   { If st is not found, returns $ffff                         }
  70.   Var
  71.     buffer : Array[0..65519] of Byte Absolute buff;
  72.     chbuff : Array[0..65519] of Char Absolute buff;
  73.     s      : Array[0..255] of Byte Absolute st;
  74.     len    : Byte Absolute st;
  75.     s1     : String Absolute st;
  76.     s2     : String;
  77.     numb,
  78.     x      : Word;
  79.     found  : Boolean;
  80.   begin
  81.     s2[0] := chr(len);       { sets the length to that of the search String }
  82.     found := False;           
  83.     numb := pred(len);
  84.     While (not found) and (numb < (size - len)) do begin
  85.       if UpCase(chbuff[numb]) = s1[len] then { partial match } begin
  86.         if UpCase(chbuff[numb-pred(len)]) = s1[1] then { less partial! } begin
  87.           move(buffer[numb-pred(len)],s2[1],len);
  88.           For x := 1 to length(s2) do
  89.             s2[x] := UpCase(s2[x]);
  90.           found := s1 = s2;                   { if = it is a complete match }
  91.           BMSearchUC := numb - pred(len);     { will stick unless not found }
  92.         end;
  93.         inc(numb);                 { bump by one Char - match is irrelevant }
  94.       end
  95.       else
  96.         inc(numb,Bt[ord(UpCase(chbuff[numb]))]);
  97.     end;
  98.     if not found then
  99.       BMSearchUC := $ffff;
  100.   end;  { BMSearchUC }
  101.  
  102. end.
  103.