TIP: Click on subject to list as thread! ANSI
echo: pascal
to: ALLEN WALKER
from: KIM FORWOOD
date: 1998-04-15 23:03:00
subject: Re: In case anyone is interes

Allen Walker wrote: 
 AW> If you don't like it, make one yourself. I just was *nice* enough to
 AW> try to make others lives easier.
{==========================================================================}
PROGRAM Patcher;      { patch/unpatch EXE's with pentium "div by zero" bug }
{--------------------------------------------------------------------------}
{ Copywrong (c) 1998 All Rights Reversed                                   }
{--------------------------------------------------------------------------}
{$DEFINE DEBUG}
{$IFDEF DEBUG}
{$D+,L+,I+,S+}
{$ELSE}
{$D-,L-,I-,S-}
{$ENDIF}
{$M 65520,0,655360}
uses Crt, Dos;
const
   OldPattern : array[0..8] of byte = (247,208,247,210,185,055,000,247,240);
   NewPattern : array[0..8] of byte = (247,208,247,210,184,255,255,144,143);
const
   USER_ABORT : boolean = False;
const
   Subs : boolean = False;
   Auto : boolean = False;
   Logs : boolean = False;
   Undo : boolean = False;
var
   Buffer: array[0..$7FFF] of byte;
   StartDir: string;
   SR: SearchRec;
   Rpt: text;
   B: byte;
{==========================================================================}
 FUNCTION PadR(S: string; Len: byte): string;
{--------------------------------------------------------------------------}
begin
   while Length(S) < Len do S := S + ' ';
   PadR := S;
end; { PadR }
{==========================================================================}
 FUNCTION DirExists(Dir: string): boolean;
{--------------------------------------------------------------------------}
var
   Attr: word;
   F: file;
begin
   if Dir[Length(Dir)]  '\' then Dir := Dir + '\';
   Dir := Dir + '.';
   Assign(F,Dir);
   GetFAttr(F,Attr);
   DirExists := (Attr and $10 = $10);
end;  { DirExists }
{==========================================================================}
FUNCTION UserKey(S,Opts: string): char;
{--------------------------------------------------------------------------}
var
   Ch: char;
begin
   Write(S);
   repeat Ch := UpCase(ReadKey) until Pos(Ch,Opts) > 0;
   UserKey := Ch;
   WriteLn(Ch);
end; { UserKey }
{==========================================================================}
 PROCEDURE Spinner(X,Y,Speed: byte);
{--------------------------------------------------------------------------}
const
   SpinChr : array[0..3] of char = ('|','/','-','\');
   Counter : byte = 0;
   Pause   : longint = MAXINT;  { $7FFF }
begin
   if Speed > 0 then begin
      if Pause >= MAXINT then begin
         Pause := 0;
         if Counter = 3 then Counter := 0 else Inc(Counter);
         GotoXY(X,Y);
         Write(SpinChr[Counter mod 4]+#8);
      end;
      Inc(Pause,Speed);
   end
end; { Spinner }
{==========================================================================}
 PROCEDURE ProcessFile(FName: string);
{--------------------------------------------------------------------------}
var
   Found: boolean;
   Count: byte;
   FLoc: longint;
   BLoc: longint;
   NR: word;
   Ch: char;
   F: file;
begin
   if not Auto then begin
      Ch := UserKey('Process '+FName+'? (Y/N/Q) ','YNQ');
      if Ch = 'Q' then USER_ABORT := True;
      if Ch  'Y' then Exit;
   end;
   Write('Processing ',FName,'...  ');
   Assign(F,FName);
   {$I-}
   ReSet(F,1);
   {$IFDEF DEBUG} {$I+} {$ENDIF}
   if IoResult = 0 then begin
      FLoc  := 0;
      Count := 0;
      Found := False;
      while not Eof(F) do begin
         BLoc  := 0;
         FillChar(Buffer,SizeOf(Buffer),#0);
         BlockRead(F,Buffer,SizeOf(Buffer),NR);
         while (BLoc <= NR) and Not(Found) do begin
            Spinner(WhereX,WhereY,180);
            if Undo then begin
               if Buffer[BLoc] = NewPattern[Count] then Inc(Count)
               else Count := 0;
            end
            else begin
               if Buffer[BLoc] = OldPattern[Count] then Inc(Count)
               else Count := 0;
            end;
            if Count = 9 then Found := True;
            Inc(BLoc);
         end;
         Inc(FLoc,BLoc);
         if Found then begin
            Seek(F,FLoc-9);
            if Undo then BlockWrite(F,OldPattern,9)
            else BlockWrite(F,NewPattern,9);
            Write(#251#32);
            if Logs then WriteLn(Rpt,PadR(FName,60),'Offset: ',FLoc-9);
            Found := False;
            Count := 0;
         end
         else Dec(FLoc);
      end;
      WriteLn(' done.');
      Close(F);
   end
   else begin
      WriteLn('Error opening ',FName);
      if Logs then WriteLn(Rpt,'Error opening ',FName);
   end
end; { ProcessFile }
{==========================================================================}
 PROCEDURE ScanDirectories(DS: string);
{--------------------------------------------------------------------------}
var
   SR: SearchRec;
begin
   if DS[Length(DS)]  '\' then DS := DS + '\';
   FindFirst(DS+'*.*',$3F,SR);
   while (DosError = 0) and (not USER_ABORT) do begin
      if (SR.Attr and ($08 or $04 or $02 or $01) = 0) then begin
         if (SR.Attr and $10 = 0) then begin
            if Copy(SR.Name,Length(SR.Name)-3,4) = '.XXX' then
               ProcessFile(DS+SR.Name)
         end
         else if Subs and (SR.Name[1]  '.') then
            ScanDirectories(DS+SR.Name);
      end;
      FindNext(SR);
   end
end; { ScanDirectories }
BEGIN
   WriteLn('Remake of Weird Al Walker''s TP CRT/FastCPU Mini-Patcher');
   WriteLn;
   Inc(OldPattern[8]);
   Inc(NewPattern[8]);
   Write('Starting directory: ');
   ReadLn(StartDir);
   if StartDir = '' then StartDir := '.\'
   else if StartDir[Length(StartDir)]  '\' then StartDir := StartDir + '\';
   StartDir := FExpand(StartDir);
   if DirExists(StartDir) then begin
      if UserKey('Patch or Unpatch? (P/U) ','PU') = 'U' then Undo := True;
      if UserKey('Span subdirectories? (Y/N) ','YN') = 'Y' then Subs := True;
      if UserKey('Run automatically? (Y/N) ','YN') = 'Y' then Auto := True;
      if UserKey('Log changes? (Y/N) ','YN') = 'Y' then begin
         Logs := True;
         Assign(Rpt,'PATCH.RPT');
         ReWrite(Rpt);
      end;
      ScanDirectories(StartDir);
      if Logs then Close(Rpt);
   end
   else WriteLn('Invalid directory');
END.
Enjoy...
Kim Forwood
--- Blue Wave/DOS v?.??
---------------
* Origin: The Eclectic Lab (1:153/831)

SOURCE: echomail via exec-pc

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.