Turbo Toolbox/Turbo_Toolbox.iso/1989/07/tricks/patchen.pas

Pascal/Delphi Source File | 1989-03-21 | 5.3 KB | 194 lines

(* ------------------------------------------------------ *)
(*                    PATCHEN.PAS                         *)
(*     Version 2.0 des allgemeinen Patch-Programms        *)
(*        (c) 1989 Chr. Diederichsen & TOOLBOX            *)
(* ------------------------------------------------------ *)
PROGRAM Patchen;

USES Dos, Crt;

CONST
  BufSize   = 32768;
                    { muß komplett ins Datensegment passen }
  MaxSearch = 80;

TYPE
  String80 = STRING[80];

VAR
  InF, OutF          : FILE;
  OutFName, InFName  : String80;
  InCnt, OutCnt      : Word;
  FilePos            : LongInt;
  Equal, FileEnd     : Boolean;
  Buffer             : ARRAY[1..BufSize] OF Byte;
  Search, Change     : ARRAY[1..MaxSearch] OF Byte;
  MaxByte            : Byte;
  i, found           : Integer;
  hr, Min, Sec, hsec : Word;
  Second1, Second2   : Real;

  PROCEDURE OpenFiles;       { und initialisiere die Suche }
  BEGIN
    IF ParamCount = 0 THEN BEGIN
      WriteLn('Aufruf PATCH InFile [Outfile]');
      WriteLn('mindestens ein Dateiname muß ',
              'angegeben werden!');
      WriteLn('Dateiname Input:  '); ReadLn(InFName);
      WriteLn('Dateiname Output: '); ReadLn(OutFName);
    END ELSE
      IF ParamCount = 1 THEN BEGIN
        InFName := ParamStr(1);
        IF ParamStr(2) = '' THEN BEGIN
          OutFName := InFName;
          Delete(OutFName, Pos('.', OutFName) + 1, 3);
          OutFName := OutFName + 'tmp';
        END ELSE OutFName := ParamStr(2);
      END ELSE
        IF ParamCount = 2 THEN BEGIN
          InFName := ParamStr(1);
          OutFName := ParamStr(2);
        END;
{$i-} ;
    Assign(InF, InFName);
    Reset(InF, 1);
    IF IOResult <> 0 THEN BEGIN
      WriteLn('Fehler beim Öffnen von InF');
      Halt(1);
    END;
    Assign(OutF, OutFName);
    Rewrite(OutF, 1);
    IF IOResult <> 0 THEN BEGIN
      WriteLn('Fehler beim Öffnen von OutF');
      Halt(1);
    END;
{$i+}
  END;

  PROCEDURE Initialize;
  VAR
    TextSearch : Boolean;
    IOByte     : Byte;
    IOString   : String80;
    CH         : Char;
  BEGIN
    WriteLn('Ändern von:    ', InFName, ' > ', OutFName);
    WriteLn;
    WriteLn('<b>yteweise oder <c>haracterweise ',
            'Suchen/Ändern? ');
    REPEAT
      CH := UpCase(ReadKey);
    UNTIL ((CH = 'B') OR (CH = 'C'));
    TextSearch := (CH = 'C');
    found := 0;
    Write('Nach wieviel ');
    IF TextSearch THEN Write('Buchstaben ')
                  ELSE Write('Bytes ');
    Write('soll gesucht werden ?  ');
    ReadLn(MaxByte);
    WriteLn;
    IF TextSearch THEN BEGIN
      Write('Suche nach:      ');
      ReadLn(IOString);
      FOR i := 1 TO MaxByte DO
        Search[i] := Ord(IOString[i]);
    END ELSE BEGIN
      Write('Suche Hex<$>/Dec nach: ');
      FOR i := 1 TO MaxByte DO BEGIN
        Read(IOByte);
        Search[i] := IOByte;
      END;
      ReadLn;
    END;
    IF TextSearch THEN BEGIN
      Write('Austausch gegen: ');
      ReadLn(IOString);
      FOR i := 1 TO MaxByte DO
        Change[i] := Ord(IOString[i]);
    END ELSE BEGIN
      Write('Hex<$>/Dec Tausch:     ');
      FOR i := 1 TO MaxByte DO BEGIN
        Read(IOByte);
        Change[i] := IOByte;
      END;
      ReadLn;
    END;
    WriteLn;
    WriteLn('Dateigröße : ', FileSize(InF) : 7, ' Bytes');
  END;

  PROCEDURE ReadBuf(VAR FPos : LongInt; VAR Last : Word;
                    VAR FileEnd : Boolean);
  VAR Reading, ReadCnt : Word;
  BEGIN
    Reading := BufSize;
    Seek(InF, FPos);
{$i-}
    BlockRead(InF, Buffer, Reading, ReadCnt);
{$i+}
    IF Reading <> ReadCnt THEN BEGIN
      Last := ReadCnt;
      FileEnd := True;
      Exit;
    END;
    Last := BufSize - MaxByte;
    FileEnd := False;
  END;

  PROCEDURE WriteBuf(VAR Last : Word);
  VAR  WriteCnt : Word;
  BEGIN
{$i-}
    BlockWrite(OutF, Buffer, Last, WriteCnt);
{$i+}
    IF Last <> WriteCnt THEN BEGIN
      WriteLn('Achtung; Datenträger ist voll');
      Halt(1);
    END;
  END;

BEGIN
  ClrScr;
  CheckBreak := TRUE;
  FileEnd    := FALSE;
  OpenFiles;
  Initialize;
  GetTime(hr, Min, Sec, hsec); { ein bißchen Statistik ... }
  Second1 := 3600*hr + 60*Min + Sec + hsec/100.0;
  found := 0;
  FilePos := 0;
  WHILE NOT FileEnd DO BEGIN
    OutCnt := 0;
    ReadBuf(FilePos, OutCnt, FileEnd);
    FOR InCnt := 1 TO OutCnt DO BEGIN
      IF Buffer[InCnt] = Search[1] THEN BEGIN
        i := 1;
        REPEAT
          Inc(i, 1);
          Equal := (Buffer[InCnt + i - 1] = Search[i]);
        UNTIL ((NOT Equal) OR (i = MaxByte));
        IF Equal THEN BEGIN
          FOR i := 1 TO MaxByte DO
            Buffer[InCnt + i - 1] := Change[i];
          InCnt := InCnt + MaxByte;
          Inc(found, 1);
        END;
      END;
      OutCnt := InCnt;
    END;
    WriteBuf(OutCnt);
    Inc(FilePos, OutCnt);
  END;
  GetTime(hr, Min, Sec, hsec);
  WriteLn('gelesen    : ', FileSize(InF) : 7,
          ' passende Stellen: ', found : 5);
  WriteLn;
  Second2 := (3600*hr + 60*Min + Sec + (hsec/100))-Second1;
  WriteLn('     Dauer : ', Second2 : 10 : 2, ' sec');
  WriteLn('  Leserate : ', (FileSize(InF)/Second2) : 8 : 2,
          ' Bytes pro sec');
  Close(InF);
  Close(OutF);
END.
(* ------------------------------------------------------ *)
(*                   Ende von PATCHEN.PAS                 *)