home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / findrepl.swg / 0004_BOYER.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  107 lines
  1.  
  2.               (* Public-domain demo of Boyer-Moore search algorithm.  *)
  3.               (* Guy McLoughlin - May 2, 1993.                        *)
  4. program DemoBMSearch;
  5.  
  6.  
  7.               (* Boyer-Moore index-table data definition.             *)
  8. type
  9.   BMTable  = array[0..255] of byte;
  10.  
  11.  
  12.   (***** Create a Boyer-Moore index-table to search with.             *)
  13.   (*                                                                  *)
  14.   procedure Create_BMTable({output} var       BMT : BMTable;
  15.                            {input }       Pattern : string;
  16.                                         ExactCase : boolean);
  17.   var
  18.     Index : byte;
  19.   begin
  20.     fillchar(BMT, sizeof(BMT), length(Pattern));
  21.     if NOT ExactCase then
  22.       for Index := 1 to length(Pattern) do
  23.         Pattern[Index] := upcase(Pattern[Index]);
  24.     for Index := 1 to length(Pattern) do
  25.       BMT[ord(Pattern[Index])] := (length(Pattern) - Index)
  26.   end;        (* Create_BMTable.                                      *)
  27.  
  28.  
  29.   (***** Boyer-Moore Search function. Returns 0 if string is not      *)
  30.   (*     found. Returns 65,535 if BufferSize is too large.            *)
  31.   (*     ie: Greater than 65,520 bytes.                               *)
  32.   (*                                                                  *)
  33.   function BMsearch({input } var BMT       : BMTable;
  34.                              var Buffer;
  35.                                  BuffSize  : word;
  36.                                  Pattern   : string;
  37.                                  ExactCase : boolean) : {output} word;
  38.   var
  39.     Buffer2 : array[1..65520] of char absolute Buffer;
  40.     Index1,
  41.     Index2,
  42.     PatSize : word;
  43.   begin
  44.     if (BuffSize > 65520)  then
  45.       begin
  46.         BMsearch := $FFFF;
  47.         exit
  48.       end;
  49.     PatSize := length(Pattern);
  50.     if NOT ExactCase then
  51.       begin
  52.         for Index1 := 1 to BuffSize do
  53.           if  (Buffer2[Index1] > #96)
  54.           and (Buffer2[Index1] < #123) then
  55.             dec(Buffer2[Index1], 32);
  56.         for Index1 := 1 to length(Pattern) do
  57.           Pattern[Index1] := upcase(Pattern[Index1])
  58.       end;
  59.     Index1 := PatSize;
  60.     Index2 := PatSize;
  61.     repeat
  62.       if (Buffer2[Index1] = Pattern[Index2]) then
  63.         begin
  64.           dec(Index1);
  65.           dec(Index2)
  66.         end
  67.       else
  68.         begin
  69.           if (succ(PatSize - Index2) > (BMT[ord(Buffer2[Index1])])) then
  70.             inc(Index1, succ(PatSize - Index2))
  71.           else
  72.             inc(Index1, BMT[ord(Buffer2[Index1])]);
  73.           Index2 := PatSize
  74.         end;
  75.     until (Index2 < 1) or (Index1 > BuffSize);
  76.     if (Index1 > BuffSize) then
  77.       BMsearch := 0
  78.     else
  79.       BMsearch := succ(Index1)
  80.   end;        (* BMsearch.                                            *)
  81.  
  82. type
  83.   arby_64K = array[1..65520] of byte;
  84.  
  85. var
  86.   Index   : word;
  87.   st_Temp : string[20];
  88.   Buffer  : ^arby_64K;
  89.   BMT     : BMTable;
  90.  
  91. BEGIN
  92.   new(Buffer);
  93.   fillchar(Buffer^, sizeof(Buffer^), 0);
  94.   st_Temp := 'aBcDeFgHiJkLmNoPqRsT';
  95.   move(st_Temp[1], Buffer^[65501], length(st_Temp));
  96.   st_Temp := 'AbCdEfGhIjKlMnOpQrSt';
  97.   Create_BMTable(BMT, st_Temp, false);
  98.   Index := BMSearch(BMT, Buffer^, sizeof(Buffer^), st_Temp, false);
  99.   writeln(st_Temp, ' found at offset ', Index)
  100. END.
  101.                                - Guy
  102. ---
  103.  ■ DeLuxe²/386 1.25 #5060 ■
  104.  * Rose Media, Toronto, Canada : 416-733-2285
  105.  * PostLink(tm) v1.04  ROSE (#1047) : RelayNet(tm)
  106.  
  107.