home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBCS / DEMOS / UGREP / usr.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1993-04-02  |  8.9 KB  |  247 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   USR was conceived, designed and written          ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  20. *)
  21. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  22. {$M 4096, 0, 40960}
  23.  
  24.  
  25. uses
  26.   dos, crt,
  27.   eco_srch, eco_lib
  28.  
  29.   ;
  30.  
  31.  
  32. const 
  33.   pk  : boolean = false;
  34.   lz  : boolean = false;
  35.   bor : boolean = false;
  36.   pkchkstring   = 'PKLITE Copr. 1990-91 PKWARE Inc. All Rights Reserved';
  37.   borland6      = 'Portions_Copyright_(c)_1983,90_Borland';
  38.   borland7      = 'Portions_Copyright_(c)_1983,92_Borland';
  39.   lzchkstring   = 'LZ91';
  40.   junk          = 'USRUǺ ≈─»89W%$()P*(7¿gpè¼╨▐9)*-1`g>EG{}%${^}::"#@$:$#';
  41.  
  42. var
  43.   sb, ll, tl,
  44.   filesiz,
  45.   back       :      longint;
  46.   startx,
  47.   starty,
  48.   index1,
  49.   index2,
  50.   i, bytes   :         word;
  51.   cvtfile    : file of char;
  52.   c          :         char;
  53.   tmp,
  54.   chkstring,
  55.   new,
  56.   chk        :       string;
  57.  
  58.  
  59.  
  60.   procedure help;
  61.   begin
  62.     writeln;
  63.     writeln('Usage: USR INFILE {SEARCHSTRING [REPLACEMENTMSG]} options');
  64.     writeln('  Search for selected string, replacement if specified, padded with');
  65.     writeln('  junk is inserted. Of course, no more than length(searchstring) bytes');
  66.     writeln('  are used in the replacement. By default 2048 bytes are searched.');
  67.     writeln;
  68.     writeln('Options:');
  69.     writeln('  /lz      search for LZEXE header.');
  70.     writeln('  /pk      search for PKLITE header.');
  71.     writeln('  /bor6    search for Turbo Pascal 6.0 header.');
  72.     writeln('  /bor7    search for Borland Pascal 7.0 header.');
  73.     writeln('  /r       reverse: replace junk with header. (specify further as normal cvt)');
  74.     writeln('  /s 0     search whole file');
  75.     writeln('  /s xxxx  search first xxxx bytes of file.');
  76.     writeln('  /t       do not translate _ into spaces in strings.');
  77.     writeln('  Use /s as last option on the commandline');
  78.     writeln;
  79.     writeln('Examples:');
  80.     writeln('  USR fil FIND           search file for FIND');
  81.     writeln('  USR fil FIND REPL      search file for FIND, replace it with REPLACE');
  82.     writeln('  USR fil /p             search file for PKLITE header, replace that with junk');
  83.     writeln('  USR fil /p JUNK /r     search file for JUNKjunk header, replace that PKhdr');
  84.     write  ('  USR fil /l REPL /s 500 search file''s first 5000 bytes for LZhdr, r/with REPL');
  85.     readkey; halt(1);
  86.   end;
  87.  
  88.  
  89.  
  90.   function seekposinfile: longint;
  91.   var
  92.     oldattr         :    word;
  93.     sizeread        :    word;
  94.     bufpointer,
  95.     longbufpos      : longint;
  96.     casesensitive,
  97.     nf              : boolean;
  98.     searchfile      :    file;
  99.  
  100.   begin
  101.     assign(searchfile, paramstr(1));
  102.     getfattr(searchfile, oldattr); setfattr(searchfile, archive);
  103.     {$I-} reset(searchfile,1); {$I+}
  104.     if ioresult<>0 then begin
  105.       writeln('File not found / cannot be accessed.'); halt;
  106.     end;
  107.     target := chkstring; nf := false; casesensitive := true;
  108.     make_boyer_moore_table(target, table1, table2, casesensitive);
  109.     longbufpos := 0; seekposinfile := 0;
  110.  
  111.     repeat
  112.       seek(searchfile, longbufpos);
  113.       blockread(searchfile, buffer, maxbuffer, sizeread);
  114.       maxpos := sizeread - ord(target[0]); bufpointer := 0;
  115.       repeat
  116.         i := boyer_moore_search(
  117.           buffer, bufpointer, sizeread,
  118.           target, table1, table2, casesensitive
  119.         );
  120.         if (i > 0) then begin
  121.           bufpointer := i+length(target);
  122.           if keypressed then if readkey = #27 then nf := true;
  123.           seekposinfile := longbufpos + i;
  124.         end
  125.       until (i = 0) or (bufpointer > maxpos) or (sizeread=0) or nf;
  126.       longbufpos := longbufpos + maxpos;
  127.     until nf or (sizeread < maxbuffer);
  128.     setfattr(searchfile, oldattr); close(searchfile);
  129.   end;
  130.  
  131.  
  132.  
  133. {main}begin
  134.   if not __isconfil(__handlfil(output)) then __stdio;
  135.   textcolor(yellow); 
  136.   writeln('USR - Universal String Replacement Utility -- Version 1.1');
  137.   writeln('(C) MCMXCIII by UltiHouse Software / The ECO Group.');
  138.   writeln('Part of the UltiGREP package: GSR, USR, QF, UGREP.');
  139.   textcolor(lightgray);
  140.   if (
  141.     (paramcount = 0) or __inparams('/?', i) or 
  142.     __inparams('-?', i) or __inparams('?', i)
  143.   ) then help;
  144.  
  145.   chkstring := pkchkstring; ll := length(pkchkstring);
  146.  
  147.   chkstring := paramstr(2);
  148.   if chkstring[1] = '/' then begin { no searchstring specified }
  149.     if __inparams('/pk', i) then begin 
  150.       pk := true; chkstring := pkchkstring
  151.     end else if __inparams('/lz', i) then begin
  152.       lz := true; chkstring := lzchkstring
  153.     end else if __inparams('/bor6', i) then begin
  154.       bor := true; chkstring := borland6;
  155.     end else if __inparams('/bor7', i) then begin
  156.       bor := true; chkstring := borland7;
  157.     end else begin { no alternative, so: }
  158.       writeln('No searchstring, no /pk, /lz /bor6 or /bor7 specified.');
  159.       halt(0);
  160.     end;
  161.   end;
  162.   ll := length(chkstring);
  163.   if not __inparams('/t', i) then for i := 1 to ll do
  164.     if chkstring[i] = '_' then chkstring[i] := ' ' else chkstring[i] := chkstring[i];
  165.   
  166.   tmp := paramstr(3);
  167.   new := junk;           { replacement also specified }
  168.   if tmp[1] <> '/' then if not __inparams('/t', i) then 
  169.     for i := 1 to length(tmp) do
  170.       if tmp[i] = '_' then new[i] := ' ' else new[i] := tmp[i];
  171.   new[0] := chr(ll); { whatever, junk, or (partially) covered with user specs }
  172.  
  173.  
  174.   filesiz := __sizefil(paramstr(1));
  175.   sb := 2048;
  176.   if __inparams('/s', i) then begin
  177.     sb := __val(paramstr(i)); 
  178.     if sb = 0 then sb := filesiz - ll - 1;
  179.     if sb < ll then sb := ll + 1;
  180.     write('Searching ', sb, ' bytes in a ');
  181.   end else write('Searching in a ');
  182.   if lz then writeln('LZEXE file.') else if pk then
  183.     writeln('PKLITE file.') else if bor then writeln('Borland EXE-file.') else
  184.       writeln('file.');
  185.  
  186.   if __inparams('/r', i) then begin
  187.     tmp := chkstring; chkstring := new; new := tmp;
  188.     writeln('Reverse mode --');
  189.     write(
  190.       '  ' + copy(paramstr(3), 1, ll) + ' + standaardjunk is' +#13#10 + 
  191.       '  replaced with a '
  192.     );
  193.     if pk then writeln('PKLITE header.') else
  194.       if lz then writeln('LZEXE header.') else
  195.       if bor then writeln('Borland EXE header.') else
  196.         writeln('Original header');
  197.   end;
  198.  
  199.  
  200.  
  201.  
  202.   { SEARCHING }
  203.   write('Seeking . . .'); chk := ''; bytes := 0;
  204.   if (filesiz > 5000) and (sb > 2000) then begin
  205.     write(' quick . . .');
  206.     tl := seekposinfile;
  207.     assign(cvtfile, paramstr(1)); reset(cvtfile); seek(cvtfile, tl);
  208.     if tl > 0 then begin
  209.       write(' found . . .'); chk := chkstring;
  210.     end;
  211.   end else begin
  212.     assign(cvtfile, paramstr(1)); reset(cvtfile); read(cvtfile, c);
  213.     while not(eof(cvtfile) or (chk = chkstring) or (bytes > sb)) do begin
  214.       while not((c = chkstring[1]) or eof(cvtfile)) do begin
  215.         read(cvtfile, c); inc(bytes); 
  216.       end;
  217.       { char found, if not base of correct string, jump back to one after it }
  218.       back := filepos(cvtfile) + 1;
  219.       i := 1; chk := chkstring[1];
  220.       while ((i < ll) and (chk[i]=chkstring[i]) and not(eof(cvtfile))) do begin
  221.         read(cvtfile, c); chk := chk + c; inc(i); inc(bytes); 
  222.       end;
  223.       if chk <> chkstring then seek(cvtfile, back);
  224.     end;
  225.     if chk = chkstring then seek(cvtfile, filepos(cvtfile) - ll);
  226.   end;
  227.  
  228.  
  229.  
  230.   { REPLACEMENT }
  231.   if chk = chkstring then begin
  232.     write(' converting . . .');
  233.     for i := 1 to ll do write(cvtfile, new[i]);
  234.     writeln(' done.');
  235.   end else begin
  236.     writeln(' not found!');
  237.     if pk then writeln('Not a PKLITE file.') else
  238.       if lz then writeln('Not a LZEXE file.') else
  239.         writeln('Not a file containing "', chkstring, '"');
  240.   end;
  241.   close(cvtfile);
  242. {happy}end.
  243. Old units:
  244.   eco_ext,  eco_fil,
  245.   eco_str,
  246.   unit_fil
  247.