source: tools/wow_patcher/wowpatcher.pas

program wowpatcher;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp
  { you can add units after this };

const
  Version = '1.2';
  ReleaseDate = '2010-09-08';

type

  { TPatcher }

  { TWoWPatcher }

  TWoWPatcher = class(TCustomApplication)
  private
    function FindSequence(Data: array of Byte; Sequence: array of Integer; Position: Integer = 0): Integer;
    procedure WriteHexData(Data: array of Integer; From, Count: Integer);
    procedure WriteHexData(Data: array of Byte; From, Count: Integer);
  protected
    procedure DoRun; override;
  public
    FileName: string;
    NewFileName: string;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
    procedure Patch;
  end;

{ TWoWPatcher }

procedure TWoWPatcher.DoRun;
begin
  WriteLn('wowpatcher ' + Version + ' ' + ReleaseDate);
  if HasOption('h', 'help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;
  if HasOption('s', 'source') then begin
    FileName := GetOptionValue('s', 'source');
  end;

  NewFileName := Copy(FileName, 1, Length(FileName) -
    Length(ExtractFileExt(FileName))) + '-2' + ExtractFileExt(FileName);
  Patch;

  Terminate;
end;

constructor TWoWPatcher.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException := True;
  FileName := 'Wow.exe';
end;

destructor TWoWPatcher.Destroy;
begin
  inherited Destroy;
end;

procedure TWoWPatcher.WriteHelp;
begin
  Writeln('Usage: ', ExtractFileName(ExeName));
  WriteLn('    -s source  Select Wow.exe source file');
  WriteLn('    -h help    Show this help');
  WriteLn;
  WriteLn('Patched exe file cannot be used safely on offical servers.');
end;

function TWoWPatcher.FindSequence(Data: array of Byte; Sequence: array of Integer; Position: Integer = 0): Integer;
var
  I: Integer;
  II: Integer;
  Same: Boolean;
begin
  if Length(Sequence) = 0 then
    raise Exception.Create('Empty searched sequence');
  Result := -1;
  for I := Position to Length(Data) - Length(Sequence) do begin
    if Data[I] = Sequence[0] then begin
      Same := True;
      for II := 0 to High(Sequence) do begin
        if (Sequence[II] <> -1) and (Data[I + II] <> Sequence[II]) then begin
          Same := False;
          Break;
        end;
      end;
      if Same then begin
        Result := I;
        Break;
      end;
    end;
  end;
end;

procedure TWoWPatcher.WriteHexData(Data: array of Integer; From, Count: Integer);
var
  I: Integer;
begin
  for I := From to From + Count - 1 do
    if Data[I] <> -1 then
      Write(IntToHex(Data[I], 2) + ' ')
      else Write('XX ');
end;

procedure TWoWPatcher.WriteHexData(Data: array of Byte; From, Count: Integer);
var
  I: Integer;
begin
  for I := From to From + Count - 1 do
    Write(IntToHex(Data[I], 2) + ' ');
end;

procedure TWoWPatcher.Patch;
var
  OriginalFile: TFileStream;
  NewFile: TFileStream;
  Buffer: array of Byte;
  Position: Integer;
  I: Integer;
  Shift: Integer;
  NotValid: Boolean;
const
  // -1 means any byte value
  StartSequence: array[0..15] of Integer = ($8D, $4D, $E8, $E8, -1, -1, -1, -1, $5B, $8B, $E5, $5D, $C3, $8D, $49, $00);
  StartSequence2: array[0..15] of Integer = ($88, $1D, -1, -1, -1, -1, $E8, -1, -1, -1, -1, $5B, $8B, $E5, $5D, $C3);
begin
    if not FileExists(FileName) then begin
      WriteLn(Format('File %s not found', [FileName]));
      Exit;
    end;
    try
      OriginalFile := TFileStream.Create(FileName, fmOpenRead);
      SetLength(Buffer, OriginalFile.Size);
      OriginalFile.Read(Buffer[0], Length(Buffer));
    finally
      OriginalFile.Free;
    end;

    WriteLn;
    Write('Searching for first sequence ');
    WriteHexData(StartSequence, 0, Length(StartSequence));
    Write('...');
    Position := FindSequence(Buffer, StartSequence, 0);
    if Position <> -1 then begin
      WriteLn('found at ' + IntToHex(Position, 8));
      Inc(Position, Length(StartSequence));
      if FindSequence(Buffer, StartSequence, Position) <> -1 then
        WriteLn('Multiple occurence found - ambiguous')
      else begin
        Shift := 0;
        repeat
          NotValid := False;
          for I := 0 to 3 do
            if Buffer[Position + Shift + 3 + I * 4] <> 0 then NotValid := True;
          if Buffer[Position + Shift + 3 + 4 * 4] <> $cc then NotValid := True;
          if NotValid then Inc(Shift);
          if Shift > 100 then begin
            WriteLn('No valid data found after sequence');
            Exit;
          end;
        until not NotValid;
        if Shift > 0 then WriteLn('Data shift after sequence: ' + IntToStr(Shift));
        Position := Position + Shift;

        WriteLn('Changing data after sequence');
        WriteHexData(Buffer, Position, 16);
        for I := 0 to 11 do
          Buffer[Position + I] := Buffer[Position + 12 + (I mod 4)];
        WriteLn(' => ');
        WriteHexData(Buffer, Position, 16);
      end;
      WriteLn;
    end else begin
      WriteLn('not found');
      Exit;
    end;

    WriteLn;
    Write('Searching for second sequence ');
    WriteHexData(StartSequence2, 0, Length(StartSequence2));
    Write('...');
    Position := FindSequence(Buffer, StartSequence2);
    if Position <> -1 then begin
      WriteLn('found at ' + IntToHex(Position, 8));
      Inc(Position, Length(StartSequence2));
      if FindSequence(Buffer, StartSequence2, Position) <> -1 then begin
        WriteLn('Multiple occurence found - ambiguous')
      end else begin
        Shift := 0;
        repeat
          NotValid := False;
          for I := 0 to 3 do
            if Buffer[Position + Shift + 3 + I * 4] <> 0 then NotValid := True;
          if Buffer[Position + Shift + 3 + 4 * 4] <> $cc then NotValid := True;
          if NotValid then Inc(Shift);
          if Shift > 100 then begin
            WriteLn('No valid data found after sequence');
            Exit;
          end;
        until not NotValid;
        if Shift > 0 then WriteLn('Data shift after sequence: ' + IntToStr(Shift));
        Position := Position + Shift;

        WriteLn('Changing data after sequence');
        WriteHexData(Buffer, Position, 16);
        for I := 0 to 11 do
          Buffer[Position + I] := Buffer[Position + 12 + (I mod 4)];
        WriteLn(' => ');
        WriteHexData(Buffer, Position, 16);
      end;
      WriteLn;
    end else begin
      WriteLn('not found');
      Exit;
    end;

  try
    WriteLn(Format('Patched file %s created', [NewFileName]));
    NewFile := TFileStream.Create(NewFileName, fmCreate);
    if Length(Buffer) > 0 then
      NewFile.WriteBuffer(Buffer[0], Length(Buffer));
  finally
    NewFile.Free;
  end;
end;

var
  Application: TWoWPatcher;

{$R wowpatcher.res}

begin
  Application := TWoWPatcher.Create(nil);
  Application.Title := 'WoW patcher';
  Application.Run;
  Application.Free;
end.