procdecomp.pas

SrcDecompiler is about creating a Delphi program decompiler. The program is written for Delphi 4 or

unit ProcDecomp;

interface

function GetRetAddress(Address: PChar): PChar;
function GetProcSize(Address: PChar): Integer;

procedure SaveJumpAddress(Param: Pointer; Address, JumpAddress: PChar; var Result: string);

implementation

uses
  DisAsm, SysUtils;

const
  TryCodeBlockA: array[0..3] of Byte = ($33, $C0, $55, $68);
  TryCodeBlockB: array[0..3] of Byte = ($33, $D2, $55, $68);
  TryCodeBlockC: array[0..3] of Byte = ($33, $C9, $55, $68);
  TryCodeBlockA8: array[8..13] of Byte = ($64, $FF, $30, $64, $89, $20);
  TryCodeBlockB8: array[8..13] of Byte = ($64, $FF, $32, $64, $89, $22);
  TryCodeBlockC8: array[8..13] of Byte = ($64, $FF, $31, $64, $89, $21);

type
  PPChar = ^PChar;
  PWord = ^Word;
  PDWord = ^Cardinal;

// Save in param the jump address
procedure SaveJumpAddress(Param: Pointer; Address, JumpAddress: PChar; var Result: string);
begin
  PPChar(Param)^ := JumpAddress;
end;

// Returns the Address containing the Ret instruction.
function GetRetAddress(Address: PChar): PChar;
var
  Size: Integer;
  DisAsm: TDisAsm;

  // check if it is a try block and scan the try block.
  function IsTryBlock: Boolean;
  var
    TempAddress: PChar;
  resourcestring
    SExceptJumpError = 'Error with jmp in except block at %p';
  begin
    // Compare it to the try block code.
    Result := (CompareMem(Address, @TryCodeBlockA, Length(TryCodeBlockA)) and
               CompareMem(Address + Low(TryCodeBlockA8), @TryCodeBlockA8, Length(TryCodeBlockA))) or
              (CompareMem(Address, @TryCodeBlockB, Length(TryCodeBlockB)) and
               CompareMem(Address + Low(TryCodeBlockB8), @TryCodeBlockB8, Length(TryCodeBlockB))) or
              (CompareMem(Address, @TryCodeBlockC, Length(TryCodeBlockC)) and
               CompareMem(Address + Low(TryCodeBlockC8), @TryCodeBlockC8, Length(TryCodeBlockC)));

    // if there is a try block skip it.
    if Result then
    begin
      // Save the pushed address and skip to try init code.
      TempAddress := PPChar(Address + 4)^;
      Inc(Address, 14);

      // Scan to the instruction before the pushed address.
      while True do
      begin
        // check if it is a try block and scan the try block.
        if not IsTryBlock then
        begin
          // If there wasn't a try block read instruction.
          DisAsm.GetInstruction(Address, Size);
          // if this is the last instruction before the pushed address
          if Address + Size = TempAddress then
            break;
          // if the pushed address is not an instruction there is something wrong.
          if Address + Size > TempAddress then
          begin
            raise EDisAsmError.Create('Pushed Address in try block isn''t an instruction');
          end;

          // Go to the Next instruction.
          Inc(Address, Size);
        end;
      end;

      // We are now at the instruction before the pushed address.
      if Address[0] = #$C3 then
      begin
        // It's a finally block.
        // Skip the ret and jmp @HandleFinally instructions.
        Inc(Address, 6);
        // Skip the following jmp instruction.
        DisAsm.GetInstruction(Address, Size);
        Inc(Address, Size);
      end
      else
      begin
        // It's a except block.
        // The jmp instruction before the pushed address points to the end
        // of the except block.

        // read the address the jump is to.
        TempAddress := nil;
        DisAsm.Param := @TempAddress;
        DisAsm.OnJumpInstr := SaveJumpAddress;
        DisAsm.GetInstruction(Address, Size);
        DisAsm.OnJumpInstr := nil;

        // Check if the instruction was a jump (appears that it doesn't have to be a jump (coride40.bpl $2003408A)).
//        if TempAddress = nil then
//          raise EDisAsmError.CreateFmt(SExceptJumpError, [Pointer(Address)]);

        Address := Address + Size;
        // Go to the jmp address
        if Address < TempAddress then
          Address := TempAddress
        else
        begin
          // Arbritary value of 10
          if PDword(Address)^ < 10 then
            Address := Address + PDWord(Address)^ * 8 + 4;
        end;
      end;
    end;
  end;

  function IsCaseBlock: Boolean;
  var
    TempAddress: PChar;
  begin
    Result := False;
    // First instruction must be cmp Reg, ..
    if PWord(Address)^ and not $0700 = $F883 then
    begin
      TempAddress := nil;
      DisAsm.Param := @TempAddress;
      DisAsm.OnJumpInstr := SaveJumpAddress;
      DisAsm.GetInstruction(Address + 3, Size);
      DisAsm.OnJumpInstr := nil;
      // Next instruction must be a jump and the instruction after it must be
      // jmp dword ptr [Reg*4 + ...]
      if (TempAddress <> nil) and (PWord(Address + 3 + Size)^ = $24FF) and
         (Byte(Address[3 + Size + 2]) and not $38 = $85) then
      begin
        // Continue searching after the case block.
        Result := True;
        Address := TempAddress;
      end;
    end;
  end;

begin
  DisAsm := TDisAsm.Create;
  try
    // Continue reading while there isn't a ret instruction.
    while not (Address[0] in [#$C2, #$C3]) do
    begin
      if IsCaseBlock then
      begin
        // This is a case block, skip the whole block until
        // the jump jnbe address (done in IsCaseBlock).
      end
      else
        // check if it is a try block and scan the try block.
        if not IsTryBlock then
        begin
          // If there wasn't a try block read instruction.
          DisAsm.GetInstruction(Address, Size);
          Inc(Address, Size);
        end;
    end;
    DisAsm.GetInstruction(Address, Size);
  finally
    DisAsm.Free;
  end;
  Result := Address;
end;

function GetProcSize(Address: PChar): Integer;
var
  RetAddress: PChar;
begin
  RetAddress := GetRetAddress(Address);
  if RetAddress[0] = #$C3 then
    Result := RetAddress - Address + 1
  else
    Result := RetAddress - Address + 3;
end;

end.