home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / findrepl.swg / 0019_Position Search.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1993-10-28  |  3.2 KB  |  124 lines
  1. {===========================================================================
  2. Date: 10-07-93 (13:12)
  3. From: GUY MCLOUGHLIN
  4. Subj: Pos-Search Demo
  5. ---------------------------------------------------------------------------}
  6.  
  7.  {.$DEFINE DebugMode}
  8.  
  9.  {$IFDEF DebugMode}
  10.  
  11.    {$A+,B-,D+,E-,F-,I+,L+,N-,O-,R+,S+,V+}
  12.    {$M 4096,65536,65536}
  13.  
  14.  {$ELSE}
  15.  
  16.    {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  17.    {$M 4096,65536,65536}
  18.  
  19.  {$ENDIF}
  20.  
  21.               (* Public-domain Search routine, using the standard TP  *)
  22.               (* POS function. Guy McLoughlin - May 16, 1993.         *)
  23. program DemoPosSearch;
  24.  
  25.  
  26.   (***** Force alphabetical characters to uppercase.                  *)
  27.   (*                                                                  *)
  28.   procedure UpCaseData({input } var Data;
  29.                                     wo_Size : word); far; assembler;
  30.   asm
  31.     push  ds
  32.     cld
  33.     lds   si, Data
  34.     mov   di, si
  35.     mov   cx, wo_Size
  36.     xor   ah, ah
  37.  
  38.   @L1:
  39.     jcxz  @END
  40.     lodsb
  41.     cmp   al, 'a'
  42.     jb    @L2
  43.     cmp   al, 'z'
  44.     ja    @L2
  45.     sub   al, 20h
  46.  
  47.   @L2:
  48.     stosb
  49.     loop  @L1
  50.  
  51.   @END:
  52.     pop ds
  53.  
  54.   end;        (* UpCaseData.                                          *)
  55.  
  56.  
  57.   (***** PosSearch function. Returns 0 if string is not found.        *)
  58.   (*     Returns 65,535 if BufferSize is too large.                   *)
  59.   (*     ie: Greater than 65,520 bytes.                               *)
  60.   (*                                                                  *)
  61.   function PosSearch({input } var Buffer;
  62.                                   BuffSize  : word;
  63.                                   Pattern   : string;
  64.                                   ExactCase : boolean) : {output} word;
  65.   type
  66.     arwo_2    = array[1..2] of word;
  67.     arch_255  = array[1..255] of char;
  68.   var
  69.     po_Buffer  : ^arch_255;
  70.     by_Temp,
  71.     by_IncSize : byte;
  72.     wo_Index   : word;
  73.   begin
  74.     if (BuffSize > 65520) then
  75.       begin
  76.         PosSearch := $FFFF;
  77.         exit
  78.       end;
  79.     by_IncSize := (255 - pred(length(Pattern)));
  80.     po_Buffer := addr(Buffer);
  81.     if NOT ExactCase then
  82.       begin
  83.         UpCaseData(po_Buffer^, BuffSize);
  84.         for wo_Index := 1 to length(Pattern) do
  85.           Pattern[wo_Index] := upcase(Pattern[wo_Index])
  86.       end;
  87.  
  88.     wo_Index := 0;
  89.     repeat
  90.       by_Temp := pos(Pattern, po_Buffer^);
  91.       if (by_Temp = 0) then
  92.         begin
  93.           inc(wo_Index, by_IncSize);
  94.           inc(arwo_2(po_Buffer)[1], by_IncSize)
  95.         end
  96.       else
  97.         inc(wo_Index, by_Temp)
  98.     until (by_Temp <> 0) or (wo_Index > BuffSize);
  99.     if (by_Temp = 0) then
  100.       PosSearch := 0
  101.     else
  102.       PosSearch := wo_Index
  103.   end;        (* PosSearch.                                           *)
  104.  
  105.  
  106. type
  107.   arby_64K = array[1..65520] of byte;
  108.  
  109. var
  110.   Index   : word;
  111.   st_Temp : string[20];
  112.   Buffer  : ^arby_64K;
  113.  
  114. BEGIN
  115.   new(Buffer);
  116.   fillchar(Buffer^, sizeof(Buffer^), 0);
  117.   st_Temp := 'aBcDeFgHiJkLmNoPqRsT';
  118.   move(st_Temp[1], Buffer^[65501], length(st_Temp));
  119.   st_Temp := 'AbCdEfGhIjKlMnOpQrSt';
  120.   Index := PosSearch(Buffer^, sizeof(Buffer^), st_Temp, false);
  121.   writeln(st_Temp, ' found at offset ', Index)
  122. END.
  123.  
  124.