pefileclass.pas

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

                [Pointer(MaxAddress), Pointer(TDecompItem(CodeItems[I]).Address)]);
            {$ENDIF}
          end;
        end;

        while MaxAddress < TDecompItem(CodeItems[I]).Address do
        begin
          {$IFOPT D+`}Inc(DbugCounter);{$ENDIF}
          if AnaUnknownBlock(MaxAddress, TDecompItem(CodeItems[I]).Address) then
          begin
            goto ReDo;
          end;
//          {$IFOPT D+}Assert(MaxAddress <= TDecompItem(CodeItems[I]).Address,
//             'MaxAddress higher than lowest address,' + IntToStr(DbugCounter));{$ENDIF}
          if MaxAddress > TDecompItem(CodeItems[I]).Address then
          begin
            {$IFOPT D+}SendDebug('Max higher than lowest ' + IntToStr(DbugCounter));{$ENDIF} 
            goto ReDo;
          end;
        end;

        Assert(TDecompItem(CodeItems[I]).Address = MaxAddress, 'Lowest address must be Max address');

        {$IFOPT D+}
        LastDC := TDecompItem(CodeItems[I]);
        {$ENDIF D+}
        // Save the end address of the lowest code item as max address.
        MaxAddress := TDecompItem(CodeItems[I]).Address + TDecompItem(CodeItems[I]).Size;
      end;
    finally
      CodeItems.Free;
    end;
  end;

  procedure LoadUnitNames;
  var
    I: Integer;
  begin
    // The first unit in the list is always SysInit and the second System
    Units.SysInitUnit.Name := 'SysInit';
    if Units.SystemUnit <> nil then
      Units.SystemUnit.Name := 'System';

    // Extract names from Classes.
    for I := 0 to Classes.Count -1 do
      if Classes[I].AClass.ClassInfo <> nil then
        (Classes[I].AUnit as TUnit).Name := GetTypeData(Classes[I].AClass.ClassInfo)^.UnitName;
    // Extract names from Interfaces.
    for I := 0 to TypeInfos.Count -1 do
      if TypeInfos[I].TypeInfo^.Kind = tkInterface then
        (TypeInfos[I].AUnit as TUnit).Name := GetTypeData(TypeInfos[I].TypeInfo)^.IntfUnit;
  end;

  procedure LoadImportedProcs;
  var
    I, J, K, L: Integer;
    Proc: TProc;
    NMInfo: TNameManglingInfo;
  label
    NextFixup;
  begin
    // Imported procs can be identefied by a hard coded pointer to a imported proc address
    // Loop though all the fixups which are pointers to somewhere inside the
    // Data Section (where the imported procs addresses are).
    for I := 0 to Fixups.Count -1 do
      if (Fixups[I].FixupType = 3) and
         (PPChar(Fixups[I].Address)^ >= Data) then
      begin
        // Search for imported proc address matching the fixup address.
        for J := 0 to High(Imports) do
          with Imports[J] do
          begin
            for K := 0 to High(Entries) do
            begin
              if Entries[K].PAddress = PPChar(Fixups[I].Address)^ then
              begin
                if IsPackage(Imports[J].DLLName) then
                begin
                  // Entry must a a proc.
                  NMInfo := GetNameManglingInfo(Entries[K].Name);
                  if not (NMInfo.NMType in [eitProc, eitMethod]) then
                    Continue;
                end;

                Proc := Procs.FindProc(Fixups[I].Address -2);
                if Proc <> nil then
                begin
                  // Ignore this imported proc if this imported unit initialization of finalization.
                  if (UsePackages) and
                     ((Proc.PossProcTypes = [ptInitialization]) or
                      (Proc.PossProcTypes = [ptFinalization])) then
                  begin
                    with Proc.ImportInfo do
                    begin
                      Imported := True;
                      DLLName := Imports[J].DLLName;
                      Entry := Entries[K];
                    end;
                    Continue;
                  end;
                  raise EDecompilerError.CreateFmt('Imported procedure already found %p', [Pointer(Fixups[I].Address -1)]);
                end;
                // Fixups matched, then this is a jmp [Entries].
                Proc := Procs.Add(Fixups[I].Address -2);
                with Proc do
                begin
                  Comments.Add('Imported proc');
                  Comments.Add('Imported proc name: ' + Entries[K].Name);
                  AUnit := Units.FindInUnitUsingFInit(Fixups[I].Address -2);
                  // Save all those imported stuff.
                  with ImportInfo do
                  begin
                    Imported := True;
                    DLLName := Imports[J].DLLName;
                    Entry := Entries[K];
                  end;
                  Size := 8;
                  AppendBefore := atMayNot;
                  AppendAfter := atMayNot;
                  if IsPackage(Imports[J].DLLName) then
                  begin
                    // Set the package import info
                    Name := NMInfo.ItemName;
                    TUnit(AUnit).Name := NMInfo.UnitName;
                    // Search for the imported proc, in other pefiles.
                    for L := 0 to DecompThread.PEFileClassCount -1 do
                      if AnsiCompareText(DecompThread.PEFileClasses[L].ProjectName + '.bpl', DLLName) = 0 then
                      begin
                        with ImportInfo do
                          ImportedProc := TPEFileClass(DecompThread.PEFileClasses[L]).Procs.FindProc(PPChar(Entries[K].PAddress)^);
                        PossProcTypes := ImportInfo.ImportedProc.PossProcTypes;
                        AClass := ImportInfo.ImportedProc.AClass;
                        Break;
                      end;
                    if ImportInfo.ImportedProc = nil then
                      raise EDecompilerError.CreateFmt('Imported package proc not found', []);
                  end
                  else
                  begin
                    PossProcTypes := [ptProcedure];
                  end;
                end;
                goto NextFixup;
              end;
            end;
          end;
        NextFixup:
      end;
  end;

  procedure LoadStrings;
  var
    I, J: Integer;
  label
    Next;
  begin
    for I := 0 to Fixups.Count -1 do
      with Fixups[I] do
        if (FixupType = 3) and
           (PPChar(Address)^ < Code + CodeSize) and
           (PPChar(Address)^ >= Code +8) then
        begin
          if (PDWord(PPChar(Address)^ -8)^ = $FFFFFFFF) and
             (PPChar(Address)^ + PDWord(PPChar(Address)^ - 4)^ < Code + CodeSize) and
             (PPChar(Address)^ + PDWord(PPChar(Address)^ - 4)^ >= Code) and
             ((PPChar(Address)^ + PDWord(PPChar(Address)^ -4)^)[0] = #0) and
             (StringInfos.FindString(PPChar(Fixups[I].Address)^ -8) = nil) then
          begin
            for J := 0 to PDWord(PPChar(Address)^ -4)^ -1 do
              if PPChar(Address)^[J] = #0 then
                goto Next;
            with TStringInfo.Create(StringInfos, PPChar(Fixups[I].Address)^ -8, stAnsiString) do
              Name := Format('String%p', [Pointer(PPChar(Fixups[I].Address)^)]);
          end;
        Next:
        end;
  end;

  procedure LoadResStrings;
  var
    I: Integer;
    MinIdentifier: DWord;
    ModuleAddress: PChar;
  begin
    // ResString is a block of 2 DWord, the first containing a pointer to a Module,
    // (so this must be a fixup to a BSS location) and the second containing the
    // identifier, a value equal or below $0000FFFF.

    // Get the count of the res string.
    MinIdentifier := $00010000;
    for I := 0 to High(Resources) do
      if (Resources[I].NameOrID = niID) and (Resources[I].ID = 6) then
      begin
        MinIdentifier := $00010000 - 16 - High(Resources[I].Entries) * 16;
        break;
      end;

    // The first pointer points to the var HInstance.
    I := VarInfos.IndexOfName('HInstance');
    if I <> -1 then
      ModuleAddress := VarInfos[I].Address
    else
      ModuleAddress := nil;

    for I := 0 to Fixups.Count -1 do
      with Fixups[I] do
        if (FixupType = 3) and
           ((ModuleAddress = nil) or (PPChar(Address)^ = ModuleAddress)) and
           (PDWord(Address + 4)^ <= $0000FFFF) and
           (PDWord(Address + 4)^ >= MinIdentifier) and
           (Integer(Address) mod 4 = 0) then
        begin
          // If there isn't a module address already this address must be HInstance
          if ModuleAddress = nil then
          begin
            VarInfos.LoadVar(PPChar(Address)^, 'HInstance', Units.SystemUnit);
            ModuleAddress := PPChar(Address)^;
          end;
          // Creae the res string.
          with TStringInfo.Create(StringInfos, Address, stResourceString) do
            Name := Format('ResString%p', [Pointer(Address)]);
        end;
  end;

  procedure LoadVirtualMethods;
  var
    I, J: Integer;
    ParentClassCount: Integer;
    Address: PChar;
    AAClass: TClass;
    Proc: TProc;
  const
    StdVirtualMethodNames: array[-8..-1] of string =
       ('SafeCallException', 'AfterConstruction', 'BeforeDestruction',
        'Dispatch', 'DefaultHandler', 'NewInstance', 'FreeInstance', 'Destroy');
    StdVirtualMethodParams: array[-8..-1] of string =
       ('ExceptObject: TObject; ExceptAddr: Pointer', '', '',
        'var Message', 'var Message', '', '', '');
    StdVirtualMethodResults: array[-8..-1] of string =
       ('HResult', '', '', '', '', 'TObject', '', '');
    StdVirtualMethodTypes: array[-8..-1] of TProcTypes =
      ([ptMethodProcedure], [ptMethodProcedure], [ptMethodProcedure],
       [ptMethodProcedure], [ptMethodProcedure], [ptClassProcedure],
       [ptMethodProcedure], [ptDestructor]);
  begin
      for I := 0 to Classes.Count -1 do
      begin
        AAClass := Classes[I].AClass;
        if AAClass.ClassParent <> nil then
          ParentClassCount := GetVirtualMethodCount(AAClass.ClassParent)
        else
          ParentClassCount := -9;
        // J = -8 to start with the virtual Methods in the VMT.
        for J := -8 to GetVirtualMethodCount(AAClass) -1 do
        begin
          Address := GetVirtualMethod(AAClass, J);
          if not ((J < ParentClassCount) and (GetVirtualMethod(AAClass.ClassParent, J) = Address)) then
          begin
            // Compare the Method with AbstractError procedure.
            if (Units.SystemUnit.FindProcByName(AbstractErrorProcName)<> nil) and
               (Units.SystemUnit.FindProcByName(AbstractErrorProcName).Address = Address) then
              // Set the address to nil to indicate that it is a abstract method.
              Address := nil;
            Proc := Procs.Add(Address);
            with Proc do
            begin
              Comments.Add('Virtual method');
              PossProcTypes := PossProcTypes * ptMethods;
              AClass := Classes[I];
              MethodBindingType := mbtVirtual;
              if Address = nil then
                AddReq(Units.SystemUnit.FindProcByName(AbstractErrorProcName), nil);
              MethodIndex := J;
              if J < ParentClassCount then
                Overrides := True;
              if J < 0 then
              begin
                Name := StdVirtualMethodNames[J];
                Parameters.Parameters := StdVirtualMethodParams[J];
                Parameters.FuncResult := StdVirtualMethodResults[J];
                PossProcTypes := StdVirtualMethodTypes[J];
              end;
            end;
          end;
        end;
      end;
  end;

  procedure LoadDynamicMethods;
  var
    DynamicIndexList: PDynamicIndexList;
    DynamicAddressList: PDynamicAddressList;
    I, J: Integer;
    Proc: TProc;
    AAClass: TClass;
    Address: PChar;
  resourcestring
    SDynamicMethodInsideAnother = 'DynamicMethod at %p is inside another method at %p';
  begin
      for I := 0 to Classes.Count -1 do
      begin
        AAClass := Classes[I].AClass;
        if GetDynamicMethodCount(AAClass) <> 0 then
        begin
          DynamicIndexList := GetDynamicIndexList(AAClass);
          DynamicAddressList := GetDynamicAddressList(AAClass);
          for J := 0 to GetDynamicMethodCount(AAClass) -1 do
          begin
            Address := DynamicAddressList^[J];
            // Compare the Method with AbstractError procedure.
            if (Units.SystemUnit.FindProcByName(AbstractErrorProcName) <> nil) and
               (Units.SystemUnit.FindProcByName(AbstractErrorProcName).Address = Address) then
              // Set the address to nil to indicate that it is a abstract method.
              Address := nil;
            // Search for an already existing proc.
            if (Address <> nil) then
              Proc := Procs.FindProc(Address)
            else
              Proc := nil;
            // Create a new proc if there isn't one yet.
            if Proc = nil then
              Proc := Procs.Add(Address);
            // Address of the proc and found proc must be the same.
            if Proc.Address <> Address then
              raise EDecompilerError.CreateFmt(SDynamicMethodInsideAnother, [Pointer(Address), Pointer(Proc.Address)]);

            with Proc do
            begin
              Comments.Add('Dynamic method');
              PossProcTypes := PossProcTypes * ptMethods;
              MethodIndex := DynamicIndexList^[J];
              AClass := Classes[I];
              MethodBindingType := mbtDynamic;
              Overrides := HasDynamicMethod(AAClass.ClassParent, MethodIndex);
              if Address = nil then
                AddReq(Units.SystemUnit.FindProcByName(AbstractErrorProcName), nil);
            end;
          end;
        end;
      end;
  end;

  procedure SetClassesTypeInfosUnits;
  var