home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / findrepl.swg / 0013_STSEARCH.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  1.8 KB  |  76 lines
  1. ┌─┬───────────────        Andy Stewart        ───────────────┬─╖
  2. │o│ Can someone tell/show me how to write a procedure that   │o║
  3. │o│ will take a string input and search for it in a textfile │o║
  4. ╘═╧══════════════════════════════════════════════════════════╧═╝
  5. { Simple example for a straight forward search routine }
  6. var
  7.   f    : text;
  8.   buf  : array[0..maxint] of char;
  9.   line : word;
  10.   pattern,s,t : string;
  11.  
  12. { Corrected version of routine from turbo techniques }
  13. function uppercase (strg:string):string; assembler;
  14. ASM
  15.    push     ds
  16.    lds      si,strg
  17.    les      di,@result
  18.    cld
  19.    lodsb
  20.    stosb
  21.    xor      ch,ch
  22.    mov      cl,al
  23.    jcxz     @done
  24.  @more:
  25.    lodsb
  26.    cmp      al,'a'
  27.    jb       @no
  28.    cmp      al,'z'
  29.    ja       @no
  30.    sub      al,20h
  31.  @no:
  32.    stosb
  33.    loop     @more
  34.  @done:
  35.    pop      ds
  36. END;
  37.  
  38. { If you want the above routine in pascal
  39. function uppercase (strg : string) : string;
  40.   var i : integer;
  41.   begin
  42.     for i := 1 to length(strg) do strg[i] := upcase(strg[i]);
  43.     uppercase := strg;
  44.   end;
  45. }
  46.  
  47. procedure search4pattern;
  48.   begin
  49.     readln(f,s);
  50.     inc(line);
  51.     t := uppercase(s);
  52.     if pos(pattern,t) > 0
  53.     then writeln(line:5,' ',s);
  54.   end;
  55.  
  56. begin
  57.   Line := 0;
  58.   if paramcount < 2 then exit;
  59.   pattern := paramstr(2);
  60.   pattern := uppercase(pattern);
  61.   assign(f,paramstr(1));
  62.   settextbuf(f,buf);
  63.   {$I-} reset(f); {$I+}
  64.   if ioresult = 0
  65.   then begin
  66.          while not eof(f) do search4pattern;
  67.          close(f);
  68.        end
  69.   else writeln('File not found');
  70. end.
  71. ---
  72.  ■ Tags τ Us ■ Abandon the search for truth: settle on a good fantasy.
  73.  * Suburban Software - Home of King of the Board(tm) - 708-636-6694
  74.  * PostLink(tm) v1.05  SUBSOFT (#715) : RelayNet(tm) Hub
  75.  
  76.