vars.pas

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

unit Vars;

interface

uses
  Classes, Procs, PEFile, dcDecomps, dcUnits, dcTypeIntf;

type
  TVarConst  = set of (vtVar, vtConst);
  TDecompType = (dtNormal, dtResString);

  { TVar }

  TVar = class(TDecompItem)
  private
    FInitValue: Pointer;
    FVarConst: TVarConst;
    FDecomps: TList;
    FDecompTypes: TList;
    FOffsets: TList;
    FName: string;
    FRefVar: Boolean;
    FVarSize: Integer;
    FContainType: Boolean;
    FType: IdcType;
    FAppendBefore: TAppendType;
    FAppendAfter: TAppendType;
    procedure SetInitValue(Value: Pointer);
    function GetDecompCount: Integer;
    function GetDecompItem(Index: Integer): TDecompItem;
    function GetDecompType(Index: Integer): TDecompType;
    function GetOffset(Index: Integer): Integer;
    function GetDeclaration: string;
    procedure SetVarSize(Value: Integer);
    procedure SetAppendBefore(Value: TAppendType);
    procedure SetAppendAfter(Value: TAppendType);
  protected
    procedure SetSize(Value: Integer); override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure AddDecomp(Decomp: TDecompItem; Offset: Integer; DecompType: TDecompType);
    function IsRefAddress(AAddress: PChar): Boolean; override;

    property InitValue: Pointer read FInitValue write SetInitValue;
    property VarConst: TVarConst read FVarConst write FVarConst;
    property DecompCount: Integer read GetDecompCount;
    property DecompItems[Index: Integer]: TDecompItem read GetDecompItem;
    property DecompItemTypes[Index: Integer]: TDecompType read GetDecompType;
    property OffSet[Index: Integer]: Integer read GetOffset;
    property Name: string read FName write FName;
    property ContainType: Boolean read FContainType write FContainType;
    property VarDecl: string read GetDeclaration;
    property VarSize: Integer read FVarSize write SetVarSize;
    property AType: IdcType read FType;
    property AppendBefore: TAppendType read FAppendBefore write SetAppendBefore;
    property AppendAfter: TAppendType read FAppendAfter write SetAppendAfter;
    // If RefVar is true a reference to the value of the var must be replaced by
    // a reference to the address and there shouldn't by a ref direct to the var
    // and the size must be 4, exactly on the decompitem.
    property RefVar: Boolean read FRefVar write FRefVar;
  end;

  { TVarInfos }

  TVarInfos = class(TDecompCollection)
  private
    function GetItem(Index: Integer): TVar;
    procedure SetItem(Index: Integer; Value: TVar);
  public
    procedure LoadVars;
    procedure LoadFixups;
    procedure LoadInitVars;
    procedure DeterUnits;
    procedure GenerateNames;
    function IndexOfName(Name: string): Integer;
    function IndexOfAddress(AAddress: PChar): Integer;
    procedure LoadVar(Address: PChar; Name: string; AUnit: TUnit);
    property Items[Index: Integer]: TVar read GetItem write SetItem; default;
  end;

implementation

uses
  {$IFOPT D+}dcDebug, Dialogs,{$ENDIF}
  PEFileClass, SysUtils, SysVars, NameMangling;

type
  PWord = ^Word;
  PCardinal = ^Cardinal;

{ TVar }

constructor TVar.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FVarConst := [vtVar, vtConst];
  FContainType := True;
  FType := CreateType;
end;

destructor TVar.Destroy;
begin
  FreeMem(FInitValue);
  FDecomps.Free;
  FDecompTypes.Free;
  FOffsets.Free;
  inherited Destroy;
end;

procedure TVar.SetInitValue(Value: Pointer);
begin
  Move(Value^, FInitValue^, VarSize);
end;

function TVar.GetDecompCount: Integer;
begin
  if FDecomps = nil then
    Result := 0
  else
    Result := FDecomps.Count;
end;

function TVar.GetDecompItem(Index: Integer): TDecompItem;
begin
  if FDecomps = nil then
    raise EDecompilerError.Create('Var has no decomps');
  Result := TDecompItem(FDecomps[Index]);
end;

function TVar.GetDecompType(Index: Integer): TDecompType;
begin
  if FDecompTypes = nil then
    raise EDecompilerError.Create('Var has no decomps');
  Result := TDecompType(FDecompTypes[Index]);
end;

function TVar.GetOffset(Index: Integer): Integer;
begin
  if FOffsets = nil then
    raise EDecompilerError.Create('Var has no decomps');
  Result := Integer(FOffsets[Index]);
end;

procedure TVar.SetSize(Value: Integer);
begin
  inherited SetSize(Value);
  VarSize := Value;
end;

procedure TVar.AddDecomp(Decomp: TDecompItem; Offset: Integer; DecompType: TDecompType);
begin
  if FDecomps = nil then
  begin
    FDecomps := TList.Create;
    FOffsets := TList.Create;
    FDecompTypes := TList.Create;
  end;
  FDecomps.Add(Decomp);
  FDecompTypes.Add(Pointer(DecompType));
  AddReq(Decomp, nil);
  FOffsets.Add(Pointer(Offset));
end;

function TVar.GetDeclaration: string;

  function GetIntValue(Address: PChar; Size: Integer): Cardinal;
  begin
    case Size of
      1: Result := PByte(Address)^;
      2: Result := PWord(Address)^;
      4: Result := PCardinal(Address)^;
      else
        raise EDecompilerError.CreateFmt('Unknown integer value %d', [Size]);
    end;
  end;

  function GetTypeName: string;
  const
    TypeName: array[1..4] of string = ('Byte', 'Word', '', 'Cardinal');

    function GetArrayName(ArraySize: Integer = 4): string;
    var
      I: Integer;
    begin
      if Size mod ArraySize = 0 then
      begin
        Result := Format('array[0..%d] of %s', [Size div ArraySize -1, TypeName[ArraySize]]);
        if Address < PEFileClass.BSS then
        begin
          Result := Format('%s = (%u', [Result, GetIntValue(InitValue, ArraySize)]);
          for I := 1 to VarSize div ArraySize -1 do
            Result := Format('%s, %u', [Result, GetIntValue(PChar(InitValue) + I * ArraySize, ArraySize)]);
          Result := Result + ')';
        end;
      end
      else
        Result := GetArrayName(ArraySize div 2);
    end;

  type
    TXType = (xtByte, xtWord, xtCardinal, xtString, xtPointer, xtArray);
    // if XType is xtArray then the XType after it is the the xType of the array and
    // the Value after that is the number of elements.
  var
    Types: TList;

    procedure AddVarTypes(ASize: Integer);
    var
      I: Integer;
   begin
      if ASize mod 4 = 0 then
        for I := 0 to ASize div 4 -1 do
          Types.Add(Pointer(xtCardinal))
      else if ASize mod 2 = 0 then
        for I := 0 to ASize div 2 -1 do
          Types.Add(Pointer(xtWord))
      else
        for I := 0 to ASize -1 do
          Types.Add(Pointer(xtByte))
    end;

    function GetXTypeSize(Index: Integer): Integer;
    const
      XTypeSize: array[TXType] of Integer =
        (1, 2, 4, 4, 4, 33);
    begin
      if Types[Index] = Pointer(xtArray) then
        Result := Integer(Types[Index +1]) * GetXTypeSize(Index + 1)
      else
        Result := XTypeSize[TXType(Types[Index])];
    end;

    function GetXTypeName(Index: Integer): string;
    const
      XTypeName: array[TXType] of string =
        ('Byte', 'Word', 'Cardinal', 'string', 'Pointer', 'Error');
    begin
      if Types[Index] = Pointer(xtArray) then
        Result := Format('array[0..%d] of %s', [Integer(Types[Index + 2])-1,
          GetXTypeName(Index + 1)])
      else
        Result := XTypeName[TXType(Types[Index])];
    end;

    function GetXTypeInitName(Index: Integer; Offset: Integer): string;
    var
      I: Integer;
    begin
      case TXType(Types[Index]) of
        xtByte: Result := IntToStr(PByte(PChar(InitValue) + Offset)^);
        xtWord: Result := IntToStr(PWord(PChar(InitValue) + Offset)^);
        xtCardinal: Result := IntToStr(PWord(PChar(InitValue) + Offset)^);
        xtPointer:
          begin
            for I := 0 to DecompCount -1 do
              if Self.Offset[I] = Offset then
              begin
                if DecompItems[I] is TProc then
                  Result := '@' + TProc(DecompItems[I]).Name
                else if DecompItems[I] is TVar then
                  Result := '@' + TVar(DecompItems[I]).Name
                else if DecompItems[I] is TStringInfo then
                  Result := '@' + TStringInfo(DecompItems[I]).Name
                else if DecompItems[I] is TClassInfo then
                  Result := TClassInfo(DecompItems[I]).AClass.ClassName
                else
                  raise EDecompilerError.CreateFmt('Undefined const, %s', [DecompItems[I].ClassName]);
              end;
          end;
        xtString:
          begin
            for I := 0 to DecompCount -1 do
              if Self.Offset[I] = Offset then
              begin
                Result := EnhQuotedStr((DecompItems[I] as TStringInfo).Value);
                Break;
              end;
          end;
        xtArray:
          begin
            Result := '(';
            for I := 0 to Integer(Types[Index + 2]) -1 do
              Result := Result + GetXTypeInitName(Index + 1, Offset + I * GetXTypeSize(Index +1)) + ', ';
            SetLength(Result, Length(Result) -1);
            Result[Length(Result)] := ')';
          end;
      end;
    end;

  var
    I, J: Integer;
  begin
    if DecompCount = 0 then
    begin
      // If there are known decomp items referenced use a array of a byte, Word or dword.
      if Address < PEFileClass.BSS then
        Result := '%s = %u'
      else
        Result := '%s';
      if VarSize in [1, 2, 4] then
        Result := Format(Result, [TypeName[VarSize], GetIntValue(InitValue, VarSize)])
      else
        Result := GetArrayName;
    end
    else
    begin
      Types := TList.Create;
      try
        // Create a list of the var Types.
        I := 0;
        J := 0;
        while J <> VarSize do
        begin
          if I >= DecompCount then
          begin
            // No decomp item after J
            AddVarTypes(VarSize - J);
            J := Size;
          end
          else if Offset[I] <> J then
          begin
            // No decomp item untile Offset[I]
            AddVarTypes(Offset[I] - J);
            J := OffSet[I];
          end
          else
          begin
            // Decomp item at J.
            if DecompItemTypes[I] = dtResString then
              Types.Add(Pointer(xtString))
            else
            begin
              if (DecompItems[I] is TStringInfo) and
                 (TStringInfo(DecompItems[I]).StringType in [stAnsiString]) then
                Types.Add(Pointer(xtString))
              else
                Types.Add(Pointer(xtPointer));
            end;
            Inc(J, 4);
            Inc(I);
          end;
        end;

        // Replace a row of Types with xtArray
        I := 0;
        while I < Types.Count -2 do
        begin
          if Types[I] = Types[I+1] then
          begin
            J := I+2;
            while (J < Types.Count) and (Types[J] = Types[I])  do
              Inc(J);
            Types[I] := Pointer(xtArray);
            Types.Insert(I + 2, Pointer(J - I));
            I := I + 3;
            while (I < Types.Count) and (Types[I] = Types[I-2]) do
              Types.Delete(I);
          end
          else
            Inc(I);
        end;

        // Create a record using the Types.
        if (Types.Count = 1) or
           ((Types.Count = 3) and (Types[0] = Pointer(xtArray))) then
          Result := GetXTypeName(0) + ' = ' + GetXTypeInitName(0, 0)
        else
        begin
          I := 0;
          Result := 'record';
          while I < Types.Count do
          begin