unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Bevel1: TBevel;
    Label5: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

var nf, nfb : string;

function SystemDir: string;
var
  dir: array [0..MAX_PATH] of Char;
begin
  GetSystemDirectory(dir, MAX_PATH);
  Result := StrPas(dir);
end;

function GetTempDir: string;
var
  Buffer: array[0..MAX_PATH] of Char;
begin
  GetTempPath(SizeOf(Buffer) - 1, Buffer);
  Result := StrPas(Buffer);
end;

function GetTempFile : string;
begin
  Randomize;
  repeat
    Result := ExcludeTrailingBackslash(GetTempDir) + '\~' + IntToStr(Random(8999999)+1000000) + '.TMP';
  until not FileExists(Result);
end;

function isXP : boolean;
var CurVersionInfo : TOSVersionInfo;
begin
  CurVersionInfo.dwOSVersionInfoSize := SizeOf(CurVersionInfo);
  GetVersionEx(CurVersionInfo);
  result := (CurVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and ((CurVersionInfo.dwMajorVersion=5) and (CurVersionInfo.dwMinorVersion=1));
end;

//-----------------------------------------------------------------------

function procurarpatern(var f : file; const patern : array of byte) : integer;
var buf : array[1..16384] of byte;
    pp, nbl, i : integer;
begin
  result := -1;
  pp := low(patern);
  repeat //leitura de blocos
    blockread(f, buf, sizeof(buf), nbl);
    for i := 1 to nbl do //processar bloco
    begin
      if buf[i] = patern[pp] then
        inc(pp) //prox byte de patern
      else
        pp := low(patern); //voltar ao 1º byte da patern

      if pp > high(patern) then //patern completa encontrada
      begin
        result := (FilePos(f)-1) - nbl + i - (length(patern)-1);
        exit;
      end;
    end;
  until (nbl = 0);
end;

//-----------------------------------------------------------------------

procedure TForm1.FormCreate(Sender: TObject);
begin
  if not isXP then
  begin
    Application.MessageBox('Only Windows XP supported!', pansichar(Application.Title), MB_OK or MB_ICONERROR or MB_APPLMODAL);
    Application.Terminate;
  end;

  nf := IncludeTrailingBackslash(SystemDir)+'shell32.dll';
  nfb := IncludeTrailingBackslash(SystemDir)+'shell32.ORIGINAL';
end;

procedure TForm1.Button1Click(Sender: TObject);
const patern : array [1..7] of byte = ($68,$A0,$0F,$00,$00,$6A,$03);
      patern2 : array [1..7] of byte = ($68,$60,$EA,$00,$00,$6A,$01);
var f, fb : file;
    NumRead : Integer;
    buf : array[1..16384] of byte;
    ppf : integer;
begin
  if not FileExists(nf) then
  begin
    Application.MessageBox(pansichar('File not found: '+nf), pansichar(Application.Title), MB_OK or MB_ICONERROR or MB_APPLMODAL);
    exit;
  end;

  //procurar patern
  AssignFile(f, nf);
  FileMode := 0; //read-only
  Reset(f, 1);
  try
    ppf := procurarpatern(f, patern);
  finally
    CloseFile(f);
  end;

  //se patern nao encontrada
  if ppf < 0 then
  begin
    Application.MessageBox(pansichar('File "'+nf+'" is probably already patched or unrecognized version!'), pansichar(Application.Title), MB_OK or MB_ICONERROR or MB_APPLMODAL);
    exit;
  end;

  //verificar espaço livre
  if DiskFree(ord(upcase(nf[1]))-64) < 20*1024*1024 then
  begin
    Application.MessageBox('Not enough free disk space.', pansichar(Application.Title), MB_OK or MB_ICONERROR or MB_APPLMODAL);
    exit;
  end;

  //apagar backup
  if FileExists(nfb) then //se já existe backup
    if not DeleteFile(nfb) then //apagar
      RenameFile(nfb, GetTempFile); //se n consegue apagar move p temp

  //rename .dll para .bak
  if not RenameFile(nf, nfb) then
  begin
    Application.MessageBox(pansichar('Unable to rename file "'+nf+'" to "'+nfb+'".'), pansichar(Application.Title), MB_OK or MB_ICONERROR or MB_APPLMODAL);
    exit;
  end;

  AssignFile(f, nf);
  Rewrite(f, 1);

  AssignFile(fb, nfb);
  FileMode := 0; //read-only
  Reset(fb, 1);

  try
    try
      //copiar conteudo de .bak para o novo .dll
      repeat
        BlockRead(fb, Buf, SizeOf(Buf), NumRead);
        BlockWrite(f, Buf, NumRead);
      until (NumRead = 0);

      //aplicar patch
      Seek(f, ppf);
      BlockWrite(f, patern2, sizeof(patern2)); //aplicar patch
    finally
      CloseFile(fb);
      CloseFile(f);
    end;
  except
    Application.MessageBox(pansichar('Unable to patch file: '+nf), pansichar(Application.Title), MB_OK or MB_ICONERROR or MB_APPLMODAL);
    Button2Click(Self); //se falhou, restaura backup
    exit;
  end;

  Reset(f, 1);
  form2.ShowModal;
  Application.MessageBox(pansichar('File "'+nf+'" has been successfully patched!'+#13#10#13#10+'Original file saved as "'+nfb+'".'), pansichar(Application.Title), MB_OK or MB_ICONINFORMATION or MB_APPLMODAL);
  CloseFile(f);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if not FileExists(nfb) then //se existe backup
  begin
    Application.MessageBox(pansichar('File not found: '+nfb), pansichar(Application.Title), MB_OK or MB_ICONERROR or MB_APPLMODAL);
    exit;
  end;

  if FileExists(nf) then //se existe dll
    if not DeleteFile(nf) then //apagar dll
      RenameFile(nf, GetTempFile); //se n consegue apagar move p temp

  if RenameFile(nfb, nf) then //restaura
    Application.MessageBox(pansichar('File "'+nfb+'" has been restored to "'+nf+'".'), pansichar(Application.Title), MB_OK or MB_ICONINFORMATION or MB_APPLMODAL)
  else
    Application.MessageBox(pansichar('Unable to restore file "'+nfb+'" to "'+nf+'".'), pansichar(Application.Title), MB_OK or MB_ICONERROR or MB_APPLMODAL);
end;

end.
