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)
|