home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / POSARRAY.ZIP / POSARRAY.PAS
Encoding:
Pascal/Delphi Source File  |  1988-08-02  |  2.0 KB  |  69 lines
  1.  
  2. {$R+,C-}
  3. TYPE
  4.   str255 = STRING[255];
  5.   bigarray = ARRAY[1..32767] OF Char;
  6. VAR
  7.   buffer : BigArray;
  8.   search : str255;
  9.   result : Integer;
  10.  
  11.   FUNCTION pos_array(buffer : BigArray; start : Integer;
  12.                      finish : Integer; what : str255) : Integer;
  13.  
  14.   (* To make the function ignore upper/lower CASE distinctions,
  15.      find each occurrence of the marker "{uc}" and replace it
  16.      with the TURBO function "UpCase"  *)
  17.   VAR
  18.     found   : Boolean;
  19.     L       : Byte;
  20.     rest, P : Integer;
  21.   BEGIN
  22.     found := False;
  23.     L := Length(what);
  24.     WHILE (found = False) AND ((start < finish-L) AND (start > -1)) DO
  25.       BEGIN
  26.         start := start+L;
  27.         rest  := 1;
  28.         WHILE Pos({uc}(buffer[start]), Copy(what, rest+1, L-rest)) > 0 DO
  29.           BEGIN
  30.             rest  := rest+Pos({uc}(buffer[start]), Copy(what, rest+1, L-rest));
  31.             start := start-rest+1;
  32.             P := 0;
  33.             REPEAT
  34.               P := P+1;
  35.             UNTIL {uc}(what[P]) <> {uc}(buffer[start+P-1]);
  36.             IF P > L THEN
  37.               found := True
  38.             ELSE start := start+rest-1;
  39.           END;                {if rest>0 then}
  40.       END;                    {while (found=false) and (start<finish) do}
  41.     IF found THEN pos_array := start ELSE pos_array := 0;
  42.   END;                        {procedure pos_array}
  43.  
  44.   PROCEDURE test(S : str255);
  45.     PROCEDURE explain(R : Integer);
  46.     BEGIN
  47.       IF R > 0 THEN
  48.         WriteLn('Found string at position ', R)
  49.       ELSE
  50.         WriteLn('String is not present');
  51.     END;
  52.  
  53.   BEGIN
  54.     WriteLn;
  55.     WriteLn('Searching for "', S, '"');
  56.     Write('POS_ARRAY:  ');
  57.     result := pos_array(buffer, 0, 32767, S);
  58.     explain(result);
  59.   END;
  60.  
  61. BEGIN
  62.   FillChar(buffer, SizeOf(buffer), #0);
  63.   search := 'Now is the time'; { Search string }
  64.   Move(search[1], buffer[10000], Length(search));
  65.   test(search);
  66.   test('The quick brown fox');
  67.   test('DOG');
  68. END.
  69.