ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/UTILITY/FILE/PATCHEXE.ZIP/PATCHEXE.PAS

Pascal/Delphi Source File | 1990-07-12 | 6.7 KB | 244 lines

program PatchFiles;

uses crt, dos;

const
     MaxTableEntries = 1000;

type
    fnstring = string[65];
    rawtable = array[1..MaxTableEntries] of longint;
    tabletype = ^rawtable;
    ByteFile = file of byte;
    CharFile = file of char;

var
   verbose : boolean;

   function exist(fn:fnstring):boolean;
   begin
        exist := fsearch(fn, '.') <> ''
   end;

   procedure Patch(var f:CharFile;
                       where:longint;
                       replacestring:string);
   var
      i:byte;
   begin
        writeln('Patching at ', where);
        seek(f, where);
        for i := 1 to length(replacestring) do
            write(f, replacestring[i])
   end;

   procedure SilentPatch(fname:fnstring;
                         table:tabletype;
                         entries:integer;
                         rs:string);
   var i:1..MaxTableEntries;
       inf:CharFile;
   begin
        assign(inf, fname); reset(inf);
        for i := 1 to entries do
            Patch(inf, table^[i], rs);
        close(inf)
   end;

   function max(i,j:longint):longint;
   begin
        if i >= j then max := i
                  else max := j
   end;

   function min(i,j:longint):longint;
   begin
        if i <= j then min := i
                  else min := j
   end;

   function printable(c:char):boolean;
   const
        PrintableCharacters : set of char
                            = [#32..#255];
   begin
        printable := c in PrintableCharacters
   end;

   procedure Display(var f:CharFile;
                     rmin, rmax, focus : longint;
                     highlightlength:byte);
   var i:longint;
       outc, c:char;
   begin
        seek(f, rmin);
        for i := rmin to rmax do
        begin
             read(f, c);
             if printable(c) then outc := c
                             else outc := #254;

             if (i >= focus) and (i <= (focus+highlightlength))
             then textattr := 15
             else textattr := 7;
             write(outc)
        end;
   end;

   procedure InteractivePatch(fname:fnstring;
                              table:tabletype;
                              entries : integer;
                              rs:string);
   var
      inf:CharFile;
      rmin, rmax, UpperLimit : longint;
      i : 1..MaxTableEntries;

   begin
        assign(inf, fname); reset(inf);
        Upperlimit := filesize(inf);
        for i := 1 to entries do
        begin
             rmin := max (0, table^[i] - 30);
             rmax := min (Upperlimit, table^[i] + 30);
             Display(inf, rmin, rmax, table^[i], length(rs)-1);
             writeln;
             write('Replace? ');
             if upcase(readkey) = 'Y' then
                Patch(inf, table^[i], rs);
             writeln
        end;
   end;

   procedure Work(fname:fnstring;
                  sstring, rstring:string;
                  verbose:boolean);

   label done;

   var inf:CharFile;
       entries : integer;
       table : tabletype;
       address : longint;
       i : byte;
       c : char;
       destruct : boolean;

   begin
        write('Searching...');
        entries := 0; new(table);
        assign(inf, fname); reset(inf);
        repeat
              repeat
                    if eof(inf) then goto done;
                    read(inf, c);
              until c = sstring[1];
              address := filepos(inf);

              {We'll now "try out" that chappie.}
              destruct := false;
              i := 2;
              repeat
                   if eof(inf) then goto done;
                   read(inf, c);
                   if c <> sstring[i] then destruct := true;
                   inc(i);
              until (i > length(sstring)) or destruct;

              if destruct
               then seek(inf, address)
              else {we have a occurence of searchstring}
               begin
                    inc(entries); write('.');
                    table^[entries] := address - 1
               end
        until eof(inf);

done:
    close(inf);
    if entries = 0 then
    begin
         writeln('No occurences of ', sstring, ' found.');
         halt(0)
    end;
    writeln('Finished searching.');
    if verbose then InteractivePatch(fname, table, entries, rstring)
               else SilentPatch(fname, table, entries, rstring)
                    {talk to stdout, though}
   end;

    procedure help;
    const
         NumStrings = 11;
         Strings : array[1..NumStrings] of string
                 = ('Usage:',
                    '        patch [-v] filename string1 string2',
                    '',
                    'filename is the file which is patched.',
                    'You must have length(string1) = length(string2).',
                    '',
                    'Without the verbose flag, every occurence of string1 is replaced by string2.',
                    '',
                    'With verbose on:',
                    'Every occurence of string1 is displayed on screen, along with it''s context.',
                    'Iff you give a goahead, then the patch is made.');
    var i:byte;
    begin
         for i := 1 to NumStrings do writeln(Strings[i]);
         halt(1)
    end;

    procedure courtesy;
    begin
         writeln('Say');
         writeln('      patch');
         writeln('for more help.');
         halt(1)
    end;

var
   firstparam : string;
   filename : fnstring;
   searchstring, replacestring : string;

   i : byte;

begin
     if (paramcount = 0) or (paramcount > 4) then help;
     verbose := false;
     firstparam := paramstr(1);
     if firstparam[1] = '-' then {might have a -v here}
     begin
          if upcase(firstparam[2]) = 'V'
             then verbose := true
             else help;
          filename := paramstr(2);
          searchstring := paramstr(3);
          replacestring := paramstr(4);

     end
     else {first parameter isn't -*}
     begin
          filename := paramstr(1);
          searchstring := paramstr(2);
          replacestring := paramstr(3)
     end;

     if length(searchstring) <> length(replacestring) then
     begin
          writeln('Searchstring and Replacestring must be of same length.');
          courtesy
     end;
     if length(searchstring) = 0 then
     begin
          writeln('You have to specify some searchstring.'); courtesy
     end;
     if not exist(filename) then
     begin
          writeln('File ', filename, ' not found.'); courtesy
     end;

     {Now we have all the raw materials only.}
     Work(filename, searchstring, replacestring, verbose)
end.