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