dcprocinstr.pas

这是个反向工程delphi的程序的全部源代码.能分析几乎所有的结构 Revendepro is a program to reverse engineer Delphi program. Reven

unit dcProcInstr;

interface

uses
  dcDecomps, DisAsmX, Classes, SysUtils, dcOpcToInstr;

type
  { TdcInstructions }

  TdcInstructions = class(TInterfacedObject, IInstrOwner)
  private
    FText: TStrings;
    FProc: TDecompItem;
    FItems: TList;
    FChanged: Boolean;
    function GetText: TStrings;
    function GetAddress: TAddress;
    function GetSize: Integer;
    function GetCount: Integer;
    function GetItem(Index: Integer): TInstruction;
    function GetItemIndex(Item: TInstruction): Integer;
    function InstrToPascal(Strings: TStrings): Boolean;
    procedure AddInstr(Instr: TInstruction);
  public
    constructor Create(AProc: TDecompItem);
    destructor Destroy; override;
    procedure ReplaceAssign;
    procedure ReplaceConstAssign;
    procedure OptimizeSources;

    property Text: TStrings read GetText;
    property Proc: TDecompItem read FProc;
    property Address: TAddress read GetAddress;
    property Size: Integer read GetSize;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TInstruction read GetItem; default;
    property Changed: Boolean read FChanged;
  end;

  EdcInstructionError = class(Exception);

implementation

uses
  Procs, dcInstrSource, ActiveX, dcAsmInstr, TypInfo, PEFileClass;

{ TdcInstructions }

type
  TInstructionList = array[0..MaxListSize] of TInstruction;

  TIsAddressCallbackObj = class(TObject)
  private
    PEFileClass: TPEFileClass;
    procedure Callback(Imm: TAddress; var IsAddress: Boolean);
  end;

procedure TIsAddressCallbackObj.Callback(Imm: TAddress; var IsAddress: Boolean);
begin
  IsAddress := PEFileClass.Fixups.FindFixupTo(Imm) <> -1;
end;

constructor TdcInstructions.Create(AProc: TDecompItem);
var
  AAddress: TAddress;
  IsAddressCallbackObj: TIsAddressCallbackObj;
begin
  inherited Create;
  FItems := TList.Create;

  FProc := AProc;
  with Proc as TProc do
  begin
    // Prevent further appending.
    AppendBefore := atMayNot;
    AppendAfter := atMayNot;
  end;

  IsAddressCallbackObj := TIsAddressCallbackObj.Create;
  try
    IsAddressCallbackObj.PEFileClass := TPEFileClass(TProc(Proc).PEFileClass);
    IsImmAddressCallback := IsAddressCallbackObj.Callback;
    // Create the instructions
    AAddress := TProc(Proc).Address;
    while AAddress < TProc(Proc).Address + TProc(Proc).ProcSize do
    begin
      CreateInstr(AAddress, Self);
      // Create an Asm instruction if the original create instruction is to big.
      while (Count > 0) and (Items[Count -1].Address + Items[Count -1].Size > TProc(Proc).Address + TProc(Proc).ProcSize) do
      begin
        TInstruction(FItems[Count -1]).Free;
        FItems[Count -1] := TAsmInstr.CreateOpc(AAddress,
                TProc(Proc).Address + TProc(Proc).ProcSize - AAddress);
      end;
      AAddress := Items[Count -1].Address + Items[Count -1].Size;
    end;
  finally
    IsAddressCallbackObj.Free;
    IsImmAddressCallback := nil;
  end;

  // Try Replace some assign things.
  repeat
    FChanged := False;
    ReplaceAssign;
    ReplaceConstAssign;
    OptimizeSources;
  until not Changed;
end;

destructor TdcInstructions.Destroy;
var
  I: Integer;
begin
  inherited Destroy;
  for I := 0 to FItems.Count -1 do
    TInstruction(FItems[I]).Free;
  FItems.Free;
end;

{ TProcInstrReplAssCallback }

type
  TProcInstrReplAssCallback = class(TObject)
  private
    FReg: TRegister;
    FUsed: Boolean;
    FInstrs: TdcInstructions;
    procedure Callback(Source: IInstrSource);
  public
    constructor Create(Instrs: TdcInstructions);
    function IsRegSetAgain(Reg: TRegister; InstrIndex: Integer; MayBeUsed: Boolean): Boolean;
  end;

constructor TProcInstrReplAssCallback.Create(Instrs: TdcInstructions);
resourcestring
  EInstrsNil = 'Instrs must not be nil. Bug in code.';
begin
  if Instrs = nil then
    raise Exception.Create(EInstrsNil);
  inherited Create;
  FInstrs := Instrs;
end;

procedure TProcInstrReplAssCallback.Callback(Source: IInstrSource);
var
  RegSource: IRegSource;
begin
  if not FUsed then
    if Succeeded(Source.QueryInterface(IRegSource, RegSource)) then
      if RegSource.Reg = FReg then
        FUsed := True;
end;

function TProcInstrReplAssCallback.IsRegSetAgain(Reg: TRegister; InstrIndex: Integer; MayBeUsed: Boolean): Boolean;
var
  J: Integer;
  ARegTarget: IRegSource;
begin
  // If the Reg is used as Target in the first instruction, it is set again.
  if (FInstrs[InstrIndex] is TAssignInstr) and
     Succeeded(TAssignInstr(FInstrs[InstrIndex]).Target.QueryInterface(IRegSource, ARegTarget)) and
     (ARegTarget.Reg = FReg) then
  begin
    Result := True;
    Exit;
  end;

  Result := False;
  // The Target is used as source only in the second instruction, or already
  // been set before if is used as source, because if it were used after the second
  // instruction it might be changed
  FUsed := False;
  FReg := Reg;
  for J := InstrIndex + 1 to FInstrs.Count -1 do
  begin
    if FInstrs[J] is TAssignInstr then
    begin
      if not MayBeUsed then
      begin
        // If the item is used in the source it isn't set again.
        TAssignInstr(FInstrs[J]).Source.GetSources(Callback);
        if FUsed then
          Exit;
      end;

      // If the Reg is used as Target, it is set again.
      if Succeeded(TAssignInstr(FInstrs[J]).Target.QueryInterface(IRegSource, ARegTarget)) and
         (ARegTarget.Reg = FReg) then
      begin
        // Must use the complete register.
        Result := ARegTarget.RegType = rtDWord;
        Exit;
      end;

      if not MayBeUsed then
      begin
        // If the register is used in the Target it isn't set again.
        TAssignInstr(FInstrs[J]).Target.GetSources(Callback);
        if FUsed then
          Exit;
      end;
    end
    else if FInstrs[J] is TRetInstr then
    begin
      // Reg is only used if it is eax (return value) or esp .
      Result := not (FReg in [rEax, rEsp]);
      Exit;
    end
    else
      raise EdcInstructionError.Create('Unknown Instruction');
  end;
end;

procedure TdcInstructions.ReplaceConstAssign;
// Tries replacing a Reg which has assigned a combined of his own value and const values,
// but not with a reference.
var
  ARegTarget: IRegSource;

  function IsValidSource(IsSource: IInstrSource): Boolean;
  var
    IsConstSource: IConstSource;
    IsRegSource: IRegSource;
    IsDuoSource: IDuoSource;
  begin
    Result :=
       Succeeded(IsSource.QueryInterface(IConstSource, IsConstSource)) or
       (Succeeded(IsSource.QueryInterface(IRegSource, IsRegSource)) and
        (IsRegSource.Reg = ARegTarget.Reg)) or
       (Succeeded(IsSource.QueryInterface(IDuoSource, IsDuoSource)) and
        IsValidSource(IsDuoSource.Source1) and IsValidSource(IsDuoSource.Source2));
  end;

var
  I, J: Integer;
  ReplCallback: TProcInstrReplAssCallback;
  CheckRegTarget: IRegSource;
  ANewSource: IInstrSource;
  ANewTarget: IInstrSource;
  Instr: TInstruction;
begin
  { TODO -cRequired : Check that the register references of the replaced sources are 4 bytes. }
  // All instructions must be a assign or Ret.
  for I := 0 to Count -1 do
    if not ((Items[I] is TAssignInstr) or (Items[I] is TRetInstr)) then
      Exit;
  // Last instruction must be a Ret instruction of course.
  if not ((Count > 0) and (Items[Count -1] is TRetInstr)) then
    Exit;

  ReplCallback := TProcInstrReplAssCallback.Create(Self);
  try
    for I := Count -1 downto 0 do
    begin
      // Instructions, must have as target a reg and as Source a const value.
      // Also it must be set again.
      if (Items[I] is TAssignInstr) and
         Succeeded(TAssignInstr(Items[I]).Target.QueryInterface(IRegSource, ARegTarget)) and
         (ARegTarget.RegType = rtDWord) and
         IsValidSource(TAssignInstr(Items[I]).Source) and
         ReplCallback.IsRegSetAgain(ARegTarget.Reg, I + 1, True) then
      begin
        for J := I +1 to Count -2 do
        begin
          // Replace everty reference to Reg with the constant value.
          ANewSource := TAssignInstr(Items[J]).Source.Replace(ARegTarget, TAssignInstr(Items[I]).Source);

          // Stop replacing if Reg is used as target.
          if Succeeded(TAssignInstr(Items[J]).Target.QueryInterface(IRegSource, CheckRegTarget)) and
             (ARegTarget.Reg = CheckRegTarget.Reg) then
            ANewTarget := TassignInstr(Items[J]).Target
          else
            ANewTarget := TassignInstr(Items[J]).Target.Replace(ARegTarget, TAssignInstr(Items[I]).Source);

          Instr := TAssignInstr.CreateAssign(Items[J].Address, Items[J].Size, ANewTarget, ANewSource);
          TInstruction(FItems[J]).Free;
          FItems[J] := Instr;
          FChanged := True;

          // Stop replacing if Reg is used as target.
          if Succeeded(TAssignInstr(Items[J]).Target.QueryInterface(IRegSource, CheckRegTarget)) and
             (ARegTarget.Reg = CheckRegTarget.Reg) then
            Break;
        end;
        // Remove the instruction.
        TInstruction(FItems[I]).Free;
        FItems.Delete(I);
      end;
    end;
  finally
    ReplCallback.Free;
  end;
end;

procedure TdcInstructions.ReplaceAssign;
// Tries replacing two succeeding assignment instructions with one.
var
  I: Integer;
  ASource: IInstrSource;
  ATarget: IInstrSource;
  ARegTarget: IRegSource;
  Instr: TInstruction;
  ReplCallback: TProcInstrReplAssCallback;
begin
  // All instructions must be a assign or Ret.
  for I := 0 to Count -1 do
    if not ((Items[I] is TAssignInstr) or (Items[I] is TRetInstr)) then
      Exit;
  // Last instruction must be a Ret instruction of course.
  if not ((Count > 0) and (Items[Count -1] is TRetInstr)) then
    Exit;
  { TODO -cAdditions : Add checking for call instructions, not yet needed, because there is now call suport yet. }

  ReplCallback := TProcInstrReplAssCallback.Create(Self);
  try
    // Replace two successive Assign instructions, with the first having
    // the target in the second source.
    for I := Count -1 downto 1 do
    begin
      if (Items[I] is TAssignInstr) and
          // The target of the first instruction is a register.
         (Items[I -1] is TAssignInstr) and