pefileclass.pas

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

unit PEFileClass;

interface

uses
  Classes, PEFile, Windows, SysUtils, TypInfo, dcDecompThread,
  {$IFOPT D+} dcdebug, dialogs, {$ENDIF}
  Vars, dcUnits, dcDecomps, Procs, dcNTInfoTypes, dcThrVar, dcDFMs;

type
  EDecompilerError = class(Exception);

  TProjectType = (ptProgram, ptDLL, ptPackage);

  { TPEFileClass }

  TPEFileClass = class(TPEFile)
  private
    FProjectType: TProjectType;
    FUsePackages: Boolean;
    FImportStart: PChar;
    FImportSize: Integer;
    FDecompThread: TdcDecompThread;
    function NotRecurFindTypeByName(const Name: string): TDecompItem;
    function NotRecurFindDecompItemByRef(AAddress: PChar): TDecompItem;
  public
    InitTable: PackageInfo;
    HasFFMTObj: Boolean;

    StringInfos: TStringInfos;
    Classes: TClassInfos;
    Interfaces: TInterfaces;
    TypeInfos: TTypeInfoInfos;
    NoTInfoTypes: TNoTInfoTypes;
    Procs: TProcs;
    Units: TUnits;
    Miscs: TMiscs;
    VarInfos: TVarInfos;
    EntryPointProc: TProc;
    Decomps: TDecompList;
    DFMs: TdcDFMs;
    constructor CreateDecomp(FileName: string; DecompThread: TdcDecompThread); virtual;
    destructor Destroy; override;
    procedure LoadPackages;

    function FindDecompItemByRef(AAddress: PChar): TDecompItem;
    function FindDecompItemByBlock(Address: PChar): TDecompItem;
    function FindDecompItemAfter(AAddress: PChar): TDecompItem;
    function FindTypeByName(const Name: string): TDecompItem;

    function FindSystemProc(const Name: string): TProc;

    property ProjectType: TProjectType read FProjectType;
    property UsePackages: Boolean read FUsePackages;
    property ImportStart: PChar read FImportStart;
    property ImportSize: Integer read FImportSize;
    property DecompThread: TdcDecompThread read FDecompThread;
  end;

function ListPointerToSort(Item1, Item2: Pointer): Integer;
function ListSimpleSort(Item1, Item2: Pointer): Integer;

function EnhQuotedStr(Str: string): string;

function IsIdentifier(Address: PChar): Boolean;

function IsPackage(const FileName: string): Boolean;

var
  PEFiles: array of TPEFileClass;

implementation

uses
  ObjFileConsts, DisAsm, VMTUtils, ProcDecomp, peExports,
  TypeInfoUtils, NameMangling;

{ TPEFileClass }

function ListPointerToSort(Item1, Item2: Pointer): Integer;
begin
  Result := PPChar(Item1)^ - PPChar(Item2)^;
end;

function ListSimpleSort(Item1, Item2: Pointer): Integer;
begin
  Result := Integer(Item1) - Integer(Item2);
end;

function DecompItemSort(Item1, Item2: Pointer): Integer;
begin
  Result := TDecompItem(Item1).Address - TDecompItem(Item2).Address;
end;

constructor TPEFileClass.CreateDecomp(FileName: string; DecompThread: TdcDecompThread);

  procedure LoadInitTable;
  var
    AAddress: PChar;
    I: Integer;
  resourcestring
    SErrorFindPckgInfoTable = 'Error finding the package info table';
    SErrorInInitTable = 'Error in init table';
  begin
    if ProjectType = ptPackage then
    begin
      // InitTable is pointed in the proc @PackageName@@GetPackageInfoTable$qqrv
      I := PEExports.FindCaseInSens('@' + ProjectName + '@@GetPackageInfoTable$qqrv');
      if I = -1 then
        raise EDecompilerError.Create(SErrorFindPckgInfoTable);
      InitTable := PPointer(PEExports[I].Address + 1)^;
    end
    else
    begin
      { InitTable is directly before the EntryPoint, search for the first non-fixups address
        which is not nil }
      AAddress := EntryPoint -4;
      while (PDWord(AAddress)^ = 0) or (Fixups.FindFixup(AAddress) <> -1) do
        Dec(AAddress, 4);
      InitTable := Pointer(AAddress);
    end;
    // There must be minimal 3 unit (system, SysInit, Project).
    if InitTable^.UnitCount < 3 then
      raise EDecompilerError.Create(SErrorInInitTable);
    // Create a block for the init table.
    with TDecompItem.Create(miscs) do
    begin
      Address := PChar(InitTable);
      RefAddress := PChar(InitTable);
      Size := InitTable^.UnitCount * 8 + 8;
      Comments.Add('InitTable');
    end;
  end;

  procedure RemoveProcsInAnother;
  var
    I, J: Integer;
  resourcestring
    SProcMayNotAppend = 'Proc may not append. %p';
  begin
    for I := Procs.Count -1 downto 0 do
    begin
      if Procs[I].Size <> 0 then
        for J := I +1 to Procs.Count -1 do
        begin
          if Procs[J].Address > Procs[I].Address + Procs[I].Size then
            Break;
          if Procs[J].Size <> 0 then
          begin
            if (Procs[J].Address >= Procs[I].Address) and
               (Procs[J].Address + Procs[J].Size <= Procs[I].Address + Procs[I].Size) then
            begin
              {$IFOPT D+}SendDebug(Format('Proc inside another proc %p *',
                 [Pointer(Procs[J].Address)]));{$ENDIF}
              if (Procs[J].AppendBefore = atMayNot) or (Procs[J].AppendAfter = atMayNot) then
              begin
                if Procs[I].AppendAfter = atMayNot then
                  raise EDecompilerError.CreateFmt(SProcMayNotAppend, [Pointer(Procs[J].Address)]);
                Procs[I].Size := Procs[J].Address - Procs[I].Address;
                Procs[I].ProcSize := Procs[I].Size;
                Procs[I].Comments.Add(Format('Proc truncated at %p', [Pointer(Procs[J].Address)]));
              end
              else
              begin
                Procs[I].Comments.Add(Format('Had a proc inside at %p', [Pointer(Procs[J].Address)]));
                Procs[J].Free;
              end;
              break;
            end;
          end;
        end;
    end;
  end;

  procedure AppendProcs;
  var
    Proc: TProc;
    I, J, K: Integer;
    Nothing: Boolean;
    DC: TDecompItem;
  label
    Next;
  resourcestring
    STryAppendNot4ByteProc = 'Not 4 byte aligend proc at %p can''t be appended';
  begin
    RemoveProcsInAnother;
    // Search all the not 4 byte aligned procs (not the ones in the sytem obj files).
    repeat
      Nothing := True;
    for I := Procs.Count -1 downto 1 do
    begin
      if (Procs[I].Size <> 0) and
         ((Procs[I].AUnit = nil) or (TUnit(Procs[I].AUnit).UnitType <> utSystem)) then
      begin
        // Search the first proc before the proc.
        J := I;
        repeat
          Dec(J);
          if J < 0 then
            goto Next;
        until Procs[J].Size <> 0;
        Proc := Procs[J];

        if (Integer(Procs[I].Address) mod 4 <> 0) and (Procs[I].AppendBefore <> atMayNot) then
        begin
          if Proc <> nil then
          begin
            {$IFOPT D+}
            if Procs[I].Address <> Proc.Address + Proc.Size then
              SendDebug(Format('Not filling between Proc %p %p, %p',
                [Pointer(Proc.Address), Pointer(Proc.Address + Proc.Size),
                      Pointer(Procs[I].Address)]));
            {$ENDIF}
            // Append the proc to the found proc.
            {$IFOPT D+} SendDebug(Format('Proc Append at %p and %p',
               [Pointer(Proc.Address), Pointer(Procs[I].Address)]));{$ENDIF}
            Proc.Append(Procs[I]);
            Nothing := False;
          end
          else
            raise EDecompilerError.CreateFmt(STryAppendNot4ByteProc, [Pointer(Procs[I].Address)]);
        end
        else
          if (Proc <> nil) and (Procs[I].Address = Proc.Address + Proc.Size) and
             ((Proc.AppendAfter = atMust) or (Procs[I].AppendBefore = atMust)) then
          begin
            if Proc.Size = 0 then
              goto Next;
            // Append the proc to the found proc.
            Proc.Comments.Add('Proc appended because one of the procs must');
            Proc.Append(Procs[I]);
            {$IFOPT D+}SendDebug(Format('Special Proc appended %p %p',
              [Pointer(Proc.Address), Pointer(Proc.Address + Proc.Size)]));{$ENDIF}
            Nothing := False;
          end;
        // Append the pchar before if it must append before.
        if Nothing and (Procs[I].AppendBefore = atMust) then
        begin
          DC := FindDecompItemByBlock(Procs[I].Address -1);
          if (DC <> nil) and (DC is TStringInfo) and
             (TStringInfo(DC).StringType = stPAnsiChar) then
          begin
            J := Procs[I].Address + Procs[I].Size - DC.Address;
            K := Procs[I].Address + Procs[I].ProcSize - DC.Address;
            Procs[I].Address := DC.Address;
            Procs[I].Size := J;
            Procs[I].ProcSize := K;
            DC.Free;
            Nothing := False;
          end;
        end;
      end;
      Next:
    end;
    until Nothing;
    DecompThread.CheckTerminated;
  end;

  procedure AlignProcs;
  var
    I: Integer;
  begin
    for I := 0 to Procs.Count -1 do
      if (Procs[I].AppendAfter <> atMust) and (Procs[I].Size mod 4 <> 0) then
        Procs[I].Size := Align4(Procs[I].Size);
  end;

  procedure CheckSystemCode;
  var
    LowestAddress: PChar;
    MaxAddress: PChar;
    I, J: Integer;
    CodeItems: TList;
    {$IFOPT D+}
    LastDC: TDecompItem;
    {$ENDIF}
  label
    Next;
  begin
    CodeItems := TList.Create;
    // Add all code items to the CodeItems list.
    CodeItems.Capacity := Classes.Count + TypeInfos.Count + Procs.Count + StringInfos.Count;
    for I := 0 to Classes.Count -1 do
      CodeItems.Add(Classes[I]);
    for I := 0 to TypeInfos.Count -1 do
      CodeItems.Add(TypeInfos[I]);
    for I := 0 to Procs.Count -1 do
      if (Procs[I].Size <> 0) and (Procs[I].Address <> nil) then
        CodeItems.Add(Procs[I]);
    for I := 0 to StringInfos.Count -1 do
      CodeItems.Add(StringInfos[I]);
    for I := 0 to Miscs.Count -1 do
      if Miscs[I].Address <> nil then
        CodeItems.Add(Miscs[I]);

    // Remove all the codeitem in the System unit to find overlapping code items and gaps.
    MaxAddress := Code;
    {$IFOPT D+}
    LastDC := nil;
    {$ENDIF}
    while (CodeItems.Count <> 0) and (MaxAddress <= Units.SystemUnit.FInit.Address) do
    begin
      LowestAddress := PChar(High(Integer));
      J := -1;
      for I := 0 to CodeItems.Count -1 do
      begin
        if TDecompItem(CodeItems[I]).Address < MaxAddress then
        begin
          {$IFOPT D+}
           raise EDecompilerError.CreateFmt('Overlapping code items %p %p %s' ,
             [Pointer(MaxAddress), Pointer(TDecompItem(CodeItems[I]).Address), LastDC.ClassName]);
          {$ELSE}
          raise EDecompilerError.CreateFmt('Overlapping code items %p %p' ,
             [Pointer(MaxAddress), Pointer(TDecompItem(CodeItems[I]).Address)]);
          {$ENDIF}
        end;
        if TDecompItem(CodeItems[I]).Address < LowestAddress then
        begin
          LowestAddress := TDecompItem(CodeItems[I]).Address;
          J := I;
        end;
      end;

     {$IFOPT D+}
       if LowestAddress <> MaxAddress then
         SendDebug(Format('System Gap between items %p %p',
          [Pointer(MaxAddress), Pointer(LowestAddress)]));
     {$ENDIF}
     Assert(J <> -1, 'J = -1');
      // Save the end address of the lowest code item as max address.
      MaxAddress := LowestAddress + TDecompItem(CodeItems[J]).Size;
      {$IFOPT D+}
      LastDC := TDecompItem(codeItems[J]);
      {$ENDIF}
      CodeItems.Delete(J);
    end;
    CodeItems.Free;
  end;

  procedure CheckCode;
  var
    MaxAddress: PChar;
    I: Integer;
    CodeItems: TList;