pefileclass.pas

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

      AnaHCBlock(HCBlocks[I]);

    if not UsePackages then
    begin
      // Search for Assign Object File (don't complain about the ugly search method).
      AnaObjFile(AssignObj, Low(AssignObj), AssignObjSize, AssignProcs);
      AnaObjFile(CloseObj, Low(CloseObj), CloseObjSize, CloseProcs);
      AnaObjFile(OpenTextObj, Low(OpenTextObj), OpenTextObjSize, OpenTextProcs);
      AnaObjFile(BlockReaObj, Low(BlockReaObj), BlockReaObjSize, BlockReaProcs);
      AnaObjFile(BlockwriObj, Low(BlockwriObj), BlockwriObjSize, BlockwriProcs);
      AnaObjFile(eoffileObj, Low(eoffileObj), eoffileObjSize, eoffileProcs);
      AnaObjFile(eoftextObj, Low(eoftextObj), eoftextObjSize, eoftextProcs);
      AnaObjFile(eolnObj, Low(eolnObj), eolnObjSize, eolnProcs);
      AnaObjFile(ereaseObj, Low(ereaseObj), ereaseObjSize, ereaseProcs);
      AnaObjFile(fdivObj, Low(fdivObj), fdivObjSize, fdivProcs);
      AnaObjFile(fileposObj, Low(fileposObj), fileposObjSize, fileposProcs);
      AnaObjFile(filesizeObj, Low(filesizeObj), filesizeObjSize, filesizeProcs);
      AnaObjFile(readrecObj, Low(readrecObj), readrecObjSize, readrecProcs);
      AnaObjFile(readcharObj, Low(readcharObj), readcharObjSize, readcharProcs);
      AnaObjFile(readlongObjA, Low(readlongObjA), readlongObjSize, readlongProcs, readlongObjB, Low(readlongObjB));
      AnaObjFile(readstrObj, Low(readstrObj), readstrObjSize, readstrProcs);
      AnaObjFile(readextObj, Low(readextObj), readextObjSize, readextProcs);
      AnaObjFile(readlnObj, Low(readlnObj), readlnObjSize, readlnProcs);
      AnaObjFile(renameObj, Low(renameObj), renameObjSize, renameProcs);
      AnaObjFile(openfileObj, Low(openfileObj), openfileObjSize, openfileProcs);
      AnaObjFile(seekObj, Low(seekObj), seekObjSize, seekProcs);
      AnaObjFile(seekeofObj, Low(seekeofObj), seekeofObjSize, seekeofProcs);
      AnaObjFile(seekeolnObj, Low(seekeolnObj), seekeolnObjSize, seekeolnProcs);
      AnaObjFile(settextbObj, Low(settextbObj), settextbObjSize, settextbProcs);
      AnaObjFile(truncateObj, Low(truncateObj), truncateObjSize, truncateProcs);
      AnaObjFile(strextObj, Low(strextObj), strextObjSize, strextProcs);
      AnaObjFile(writerecObj, Low(writerecObj), writerecObjSize, writerecProcs);
      AnaObjFile(pow10Obj, Low(pow10Obj), pow10ObjSize, pow10Procs);
      AnaObjFile(valextObj, Low(valextObj), valextObjSize, valextProcs);
      AnaObjFile(real2extObj, Low(real2extObj), real2extObjSize, real2extProcs);
      AnaObjFile(ext2realObj, Low(ext2realObj), ext2realObjSize, ext2realProcs);
      AnaObjFile(_llObj, Low(_llObj), _llObjSize, _llProcs);
      AnaObjFile(readint64ObjA, Low(readint64ObjA), readint64ObjSize, readint64Procs, readint64objB, low(readint64ObjB));

      AnaConst(OldLocaleOverrideKeyConstSig, OldLocaleOverrideKeyConstName);
      AnaConst(NewLocaleOverrideKeyConstSig, NewLocaleOverrideKeyConstName);

      VarInfos.LoadVar(PPChar(Units.SystemUnit.Init.Address + $D6)^, 'MainThreadID', Units.SystemUnit);
      VarInfos.LoadVar(PPChar(Units.SystemUnit.Init.Address + $C2)^, 'CmdLine', Units.SystemUnit);
      VarInfos.LoadVar(PPChar(Units.SystemUnit.Init.Address + $CC)^, 'CmdShow', Units.SystemUnit);
      VarInfos.LoadVar(PPChar(Units.SystemUnit.Init.Address + $2F)^, 'RandSeed', Units.SystemUnit);
      VarInfos.LoadVar(PPChar(Units.SystemUnit.Init.Address + $9F)^, 'Input', Units.SystemUnit);
      VarInfos.LoadVar(PPChar(Units.SystemUnit.Init.Address + $6F)^, 'ClearAnyProc', Units.SystemUnit);
      VarInfos.LoadVar(PPChar(Units.SystemUnit.Init.Address + $79)^, 'ChangeAnyProc', Units.SystemUnit);
      VarInfos.LoadVar(PPChar(Units.SystemUnit.Init.Address + $83)^, 'RefAnyProc', Units.SystemUnit);
      VarInfos.LoadVar(PPChar(Units.SystemUnit.Init.Address + $4B)^, 'Unassigned', Units.SystemUnit);
      VarInfos.LoadVar(PPChar(Units.SystemUnit.Init.Address + $54)^, 'Null', Units.SystemUnit);
      VarInfos.LoadVar(PPChar(Units.SystemUnit.Init.Address + $5D)^, 'EmptyParam', Units.SystemUnit);
    end;

    if Self.IsConsole then
      VarInfos.LoadVar(PPChar(EntryPoint + 7)^, 'IsConsole', Units.SystemUnit);

    // SysUtils
    AnaSysUtilsHCBlock(@SysUtilsHCBlock);
  end;

  procedure GetEntryPointProc;
  var
    AAddress: PChar;
    Halt0Address: PChar;
    InitExeAddress: PChar;
    ASize: Integer;
    Proc: TProc;
  const
    InitProcName: array[TProjectType] of string = ('@InitExe', '@InitLib', 'Error package doesn''t have init');
  begin
    // Package Entrypoint first have a jump to somewhere what does the some work,
    // but you can't add normal code to it.
    if ProjectType = ptPackage then
    begin
      // Get the target address of the jump and its size.
      with TDisAsm.Create do
      try
        Param := @AAddress;
        OnJumpInstr := SaveJumpAddress;
        GetInstruction(EntryPoint, ASize);
      finally
        Free;
      end;
      // Creaet a filler for the jump.
      with TDecompItem.Create(Miscs) do
      begin
        Address := EntryPoint;
        Size := Align4(ASize);
        Comments.Add('Package Entry point filler');
      end;

      // Create the real entry point proc.
      EntryPointProc := Procs.Add(AAddress);
      EntryPointProc.PossProcTypes := [ptEntryPointProc];
      EntryPointProc.Size := GetProcSize(AAddress);
      Exit;
    end;

    // For applications and libraries.
    EntryPointProc := Procs.Add(EntryPoint);
    // Set the unit to the last unit.
    EntryPointProc.AUnit := Units[Units.Count -1];
    EntryPointProc.PossProcTypes := [ptEntryPointProc];

    Proc := Units.SystemUnit.FindProcByName('@Halt0');
    if Proc = nil then
      raise EDecompilerError.Create('@Halt0 Proc doesn''t exist (this probably isn''t a Delphi 4 program.)');
    Halt0Address := Proc.Address;

    Proc := Units.SysInitUnit.FindProcByName(InitProcName[ProjectType]);
    if Proc = nil then
      raise EDecompilerError.Create(InitProcName[ProjectType] + ' Proc doesn''t exist');

    InitExeAddress := Proc.Address;
    with TDisAsm.Create do
    try
      // Add procs found be following calls.
      AAddress := EntryPoint;
      // keep looping until call to Halt0.
      repeat
        // Get the first call.
        while AAddress[0] <> #$E8 do
        begin
          GetInstruction(AAddress, ASize);
          Inc(AAddress, ASize);
          // raise an EDecompilerError if were are outside the code section.
          if AAddress > Code + CodeSize then
            raise EDecompilerError.Create('No jmp Halt found');
        end;
        Inc(AAddress, 5);
        // raise an EDecompilerError if were are outside the code section.
        if AAddress > Code + CodeSize then
          raise EDecompilerError.Create('No jmp Halt found');
        // If this is a call to @initexe set initsize to after the call.
        if AAddress + PInteger(AAddress-4)^ = InitExeAddress then
          EntryPointProc.InitSize := AAddress - EntryPoint;
      until AAddress + PInteger(AAddress -4)^ = Halt0Address;
    finally
      Free;
    end;
    EntryPointProc.ProcSize := Integer(AAddress-EntryPoint);
    EntryPointProc.Size := Align4(EntryPointProc.ProcSize);
    // At the Halt proc starts the automatic generated Code.
    EntryPointProc.FinaSize := 5;
  end;

  procedure GenerateProcNames;
  var
    Str: string;
    I: Integer;
  begin
    for I := 0 to Procs.Count -1 do
    begin
      if Procs[I].Name = '' then
      begin
        if Procs[I].AClass = nil then
        begin
          Str := Format('Proc%p', [Pointer(Procs[I].Address)]);
          Procs[I].Name := Str;
        end
        else
        begin
          if Procs[I].overrides then
          begin
            case Procs[I].MethodBindingType of
              mbtVirtual: Procs[I].Name := Procs[I].AClass.AncestorClass.GetVirtualMethod(Procs[I].MethodIndex).Name;
              mbtDynamic: Procs[I].Name := Procs[I].AClass.AncestorClass.GetDynamicMethod(Procs[I].MethodIndex).Name;
              else raise EDecompilerError.Create('not expected Method binding type');
            end;
          end
          else
          begin
            if Procs[I].Address = nil then
              Procs[I].Name := 'AbstractMethod' + IntToStr(Procs[I].MethodIndex)
            else
              Procs[I].Name := Format('Proc%p', [Pointer(Procs[I].Address)]);
          end;
        end;
      end;
    end;
  end;

  procedure AnaProcs;
  var
    I: Integer;
  begin
    I := 0;
    while (I <= Procs.Count -1) do
    begin
      // Analyse every proc, which has a name or is virtual or published (excluding the system procs) and
      // isn't imported and isn't abstract and isn't the entrypointproc.
      if ((Procs[I].Size = 0) or (Procs[I].PossProcTypes = [ptInitialization]) or (Procs[I].PossProcTypes = [ptFinalization])) and
         (not Procs[I].ImportInfo.Imported) and
         (Procs[I].Address <> nil) and
         (Procs[I].PossProcTypes <> [ptEntryPointProc]) and
         (Procs[I].AppendAfter <> atMayNot) and
         (Procs[I].Address > Units.SystemUnit.FInit.Address) then
      begin
        DecompThread.CheckTerminated;

        Procs[I].Size := GetProcSize(Procs[I].Address);
        Procs[I].ProcSize := Procs[I].Size;
        Procs.AnalyzeProc(Procs[I]);
      end;
      Inc(I);
    end;
  end;

  procedure LoadInitResStringImports;
  var
    I: Integer;
  begin
    // Reset the size to make a research for the InitResStringImports and InitImports.
    for I := 2 to Units.Count -2 do
      Units[I].Init.InitSize := Units[I].Init.InitSize;
  end;

  procedure LoadRefs;
  var
    I: Integer;
    DC: TDecompItem;
    DC2: TDecompItem;
  begin
    for I := 0 to Fixups.Count -1 do
    begin
      if (Fixups[I].FixupType = 3) and
         (Fixups[I].Address >= Units.FirstNormalUnit.Address) and
         (Fixups[I].Address < BSS + BSSSize) and
         (PPChar(Fixups[I].Address)^ < BSS + BSSSize) then
      begin
        DC := FindDecompItemByBlock(Fixups[I].Address);
        if (DC <> nil) and ((DC.AUnit = nil) or (TUnit(DC.AUnit).Index > 1)) and
           (DC.ClassType <> TDecompItem) then
        begin
          // Ignore the fixups to parts in the own code.
          if (PPChar(Fixups[I].Address)^ < DC.Address) or
             (PPChar(Fixups[I].Address)^ >= DC.Address + DC.Size) then
          begin
            DC2 := FindDecompItemByRef(PPChar(Fixups[I].Address)^);
            if DC2 = nil then
            begin
              DC.Comments.Add(Format('Emtpy req at $%p to $%p',
                  [Pointer(Fixups[I].Address), Pointer(PPChar(Fixups[I].Address)^)]));
            end
            else
              DC.AddReq(DC2, PPChar(Fixups[I].Address)^);
          end;
        end;
      end;
    end;
  end;

  procedure GenerateUnitInfos;
  var
    I: Integer;
    Next: TUnit;
    DC: TDecompItem;
    StartAddress: PChar;
    IsPart: Boolean;
  begin
    // Calculate the System and SysInit address and size with hardcode Init proc sizes.
    with Units.SystemUnit do
    begin
      Address := Code;
      Size := Init.Address + $F8 - Code;
    end;
    with Units.SysInitUnit do
    begin
      Address := Code + Units.SystemUnit.Size;
      Size := Init.Address + $8 - Address;
      StartAddress := Address + Size;
    end;

    repeat
      Next := Units.FindInUnitUsingFInit(StartAddress);
      Next.Address := StartAddress;
      // If the PChars or GUIDs following the Init proc is only used within the init proc
      // it probably is part of the Init proc.
      if Next.Init <> nil then
      begin
        Next.Size := Next.Init.Address + Next.Init.Size - StartAddress;
        // Keep looping untile a Decomp found which is not only required by Init.
        IsPart := True;
        while IsPart do
        begin
          IsPart := False;
          DC := FindDecompItemByBlock(Next.Address + Next.Size);
          // is must be a GUID or string
          if (DC is TGUIDConst) or (DC is TStringInfo) then
          begin
            for I := 0 to DC.ReqByDecompCount -1 do
              if DC.ReqByDecomps[I] <> Next.Init then
                IsPart := False;
            if IsPart then
              Next.Size := Next.Size + DC.Size;
          end;
          // Also if this is the program unit include all decomp items after it.
          if (DC <> nil) and (Next.UnitType = utProgram) then
          begin
            IsPart := True;
            Next.Size := Next.Size + DC.Size;
          end;
        end;
      end
      else
      begin
        // Init is only nil for the program unit.
        Next.Size := EntryPointProc.Address + EntryPointProc.Size - StartAddress;
      end;
      StartAddress := Next.Address + Next.Size;
    until (Next.Init = nil) or (Next.UnitType = utProgram);
  end;

  procedure FindProcsSure;
  var
    DC: TDecompItem;
    Address: PChar;
    AProc: TProc;
    ProcAdded: Boolean;
  begin
    repeat
      ProcAdded := False;
      // Search for a empty block in the Code section
      Address := Code;
      while Address + 4 < Units[Units.Count -1].FInit.Address do
      begin
        DC := FindDecompItemByBlock(Address);
        // If dc1 = nil (meaning there is no Decomps after the previous DC1 and
        if DC = nil then
        begin
          // the gap starts with push ebp ($55), mov ebp, esp ($8B, $EC) it is a proc
          if (((Address[0] = #$55) and (Address[1] = #$8B) and
               (Address[2] = #$EC)) or
              ((Address[0] = #$81) and (Address[1] = #$C4))) and
             (FindDecompItemByRef(Address) = nil) then
          begin
            AProc := Procs.Add(Address);
            with AProc do
            begin
              // It must be