mainunit.pas

dede 的源代码 3.10b

    function ClassRefInCode(Offs : DWORD; var s : String) : Boolean;
    Procedure NewTimerTimer(Sender : TObject);
  end;

var
  DeDeMainForm: TDeDeMainForm;
  DelphiVestionCompability : Byte;
  //mPEHeader : TPEHeader;

  PlugIn_DASM : TDisAsm;
  bPlugInsFixRelative : Boolean;
  DebugLogList : TStringList;

Procedure PlugIn_AddressRefProc(Param: Pointer; ValueAddress, RefAddress: PChar; var Result: string);
procedure DebugLog(sMessage : String);

//////////////////////////////////////////////////////
//// PLUGINS INTERFACE ///////////////////////////////
////
//////////////////////////////////////////////////////

function GetByte(dwVirtOffset : DWORD) : Byte;
function GetWord(dwVirtOffset : DWORD) : Word;
function GetDWORD(dwVirtOffset : DWORD) : DWORD;
function GetPascalString(dwVirtOffset : DWORD) : String;
procedure GetBinaryData(var buffer : Array of Byte; size : Integer; dwVirtOffset : DWORD);

Function Disassemble(dwVirtOffset : DWORD; var sInstr : String; var size : Integer) : Boolean;

Function GetCallReference(dwVirtOffset : DWORD; var sReference : String; var btRefType : Byte; btMode : Byte = 0) : Boolean;
Function GetObjectName(dwVirtOffset : DWORD; var sObjName : String) : Boolean;
Function GetFieldReference(dwVirtOffset : DWORD; var sReference : String) : Boolean;

const MAX_LOADED_PLUGINS = 16;

Function GetDeDe_FunctionsList : TFunctionPointerListArray;
Function LoadPlugInsFromDLL(ADllName : String) : Boolean;
procedure UnloadPluginDll(idx : integer);

Type TPlugInData = record
                     Handle : HMODULE;  // [ LC ]
                     DLL_NAME : String;
                     InternalIndex : Integer;
                     StartPlugInProc : TStartPlugInProc;
                     PlugInType : TPlugFlags;
                     sPlugInName : String;
                     sPlugInVersion : String;
                   end;

var DeDePlugins_PluginsArray : Array [1..MAX_LOADED_PLUGINS] of TPlugInData;
    DeDePlugins_Count : Byte = 0;
    GlobClassesCount : Integer;

//////////////////////////////////////////////////////

implementation

{$R *.DFM}

Uses DeDeConstants, HEXTools, DeDePAS, FMXUtils, Clipbrd,
  AboutUnit, ConverterUnit, ASMConvertUnit, ShowPEUnit, DeDeDisAsm, ASMShow,
  PreferencesUnit, DeDeReg, {ASMainUnit,} {DeDe_Projects,} BPLUnit, DCUUnit, DeDeSym,
  SymbolsUnit, ClassInfoUnit, DeDeHidden, SelProcessUnit, DeDeMemDumps,
  MakePEHUnit, DeDeClassEmulator, DOIBUnit, DeDeWpjAlf, custsetunit,
  SpyDebugUnit, DeDeRes, AnalizUnit, DeDeOffsInf, StatsUnit, IniFiles,
  DeDeDPJEng, Asm2Pas, DeDeELFClasses, DeDeZAUnit, Registry, LAUnit;


var TmpArr : Array of String;

function ExtractFileNameWOext( const Path : String ) : String;
begin
  Result := ExtractFileName( Path );
  Result := Copy( Result, 1, Length( Result ) - Length( ExtractFileExt( Result ) ) );
end;

function IsInCodeSection(RVA: DWORD): Boolean;
var idx : Integer;
    DELTA_PHYS : DWORD;
begin
  idx:=PEHeader.GetSectionIndexEx('CODE');
  DELTA_PHYS:=  PEHeader.IMAGE_BASE
               +PEHeader.Objects[idx].RVA
               -PEHeader.Objects[idx].PHYSICAL_OFFSET;
  Result:=((RVA-DELTA_PHYS)>=PEHeader.Objects[idx].PHYSICAL_OFFSET)
      and ((RVA-DELTA_PHYS)<=PEHeader.Objects[idx].PHYSICAL_OFFSET+PEHeader.Objects[idx].PHYSICAL_SIZE)
end;


{ TPackageInfoTable }

constructor TPackageInfoTable.Create;
begin
  Inherited Create;

  UnitsNames:=TStringList.Create;
  ClassesList:=TList.Create;
end;


destructor TPackageInfoTable.Destroy;
var i : Integer;
begin
  For i:=ClassesList.Count-1 downto 0  do TStringList(ClassesList[i]).Free;
  ClassesList.Free;
  UnitsNames.Free;

  Inherited Destroy;
end;

procedure TPackageInfoTable.IdentUnitNames(Sender: TObject);
var Dumper : TClassesDumper;
    ClassDmp,ClassDmp1  : TClassDumper;
    i, j, k : Integer;
    bFound : Boolean;
begin
  Dumper:=TClassesDumper(Sender);

  ////////////////////////////////////////////////
  // Enorder Units Data
  ////////////////////////////////////////////////
  Repeat
    k:=0; j:=0;
    Repeat
      if UnitsFInitPtrs[j]>UnitsFInitPtrs[j+1] then
         begin
           i:=UnitsInitPtrs[j];
           UnitsInitPtrs[j]:=UnitsInitPtrs[j+1];
           UnitsInitPtrs[j+1]:=i;
           i:=UnitsFInitPtrs[j];
           UnitsFInitPtrs[j]:=UnitsFInitPtrs[j+1];
           UnitsFInitPtrs[j+1]:=i;
           Inc(k);
         end;
       Inc(j)
     Until j>dwUnitCount-2;
  Until k=0;

  // The last unit is the project itself. The initialization pointer
  // is the program entry point and finalization is normaly null
  //
  // It is important to have repeat..until loop because the order is mportant
  j:=0;
  Repeat
    UnitsStartPtrs[j+1]:=GetNextProcRVA(UnitsInitPtrs[j],bFound,False);
    UnitsNames[j+1]:='Unit_'+DWORD2HEX(UnitsStartPtrs[j+1]);
    Inc(j);
  Until j>=dwUnitCount-1;

  // The first unit is ALWAYS system.dcu and ALWAYS starts
  // at the beginning of CODE section
  UnitsStartPtrs[0]:=PEHeader.BaseOfCode+PEHeader.IMAGE_BASE;
  UnitsNames[0]:='System';

  // The second unit is ALWAYS sysinit.pas
  UnitsNames[1]:='SysInit';

  // The last unit is ALWAYS the project
  UnitsNames[dwUnitCount-1]:=DeDeMainForm.ProjectNameLbl.Caption;

  ///////////////////////////////////////////////////
  // The same about Classes data
  ///////////////////////////////////////////////////
  Repeat
    k:=0;
    For j:=0 to dwUnitCount-2 do
     begin
      if j+1>=Dumper.Classes.Count then break;
      ClassDmp:=TClassDumper(Dumper.Classes[j]);
      ClassDmp1:=TClassDumper(Dumper.Classes[j+1]);
      if ClassDmp.FdwSelfPrt>ClassDmp1.FdwSelfPrt then
         begin
           Dumper.Classes.Exchange(j,j+1);
         end;
     end;
  Until k=0;


  ///////////////////////////////////////////////////////////////
  // Do the recognition
  ///////////////////////////////////////////////////////////////
  // Loop among all the units
  For i:=0 to Dumper.Classes.Count-1 do
    begin
      ClassDmp:=TClassDumper(Dumper.Classes[i]);

      For j:=0 to dwUnitCount-2 do
        if    (ClassDmp.FdwSelfPrt>UnitsStartPtrs[j])
          and (ClassDmp.FdwSelfPrt<UnitsStartPtrs[j+1])
          then begin
            TStringList(ClassesList[j]).Add(ClassDmp.FsClassName);
            if ClassDmp.FsUnitName<>'' then UnitsNames[j]:=ClassDmp.FsUnitName;
          end;
    end;
end;

procedure TPackageInfoTable.SetUnitCount(z: DWORD);
var i : Integer;
begin
  dwUnitCount:=z;
  SetLength(UnitsInitPtrs,z);
  SetLength(UnitsFInitPtrs,z);
  SetLength(UnitsStartPtrs,z);
  UnitsNames.Clear;
  For i:=1 to dwUnitCount do
    begin
      UnitsNames.Add('');
      ClassesList.Add(TStringList.Create);
    end;
end;

{ TClassDumper }

procedure TClassDumper.CalculatePositions;
begin
   If FdwInterfaceTlbPtr<>0 Then
      FdwInterfaceTlbPos:=FdwInterfaceTlbPtr-DELTA_PHYS;
   If FdwAutomationTlbPtr<>0 Then
    FdwAutomationTlbPos:=FdwAutomationTlbPtr-DELTA_PHYS;
   If FdwInitializationTlbPtr<>0 Then
    FdwInitializationTlbPos:=FdwInitializationTlbPtr-DELTA_PHYS;
   If FdwInformationTlbPtr<>0 Then
    FdwInformationTlbPos:=FdwInformationTlbPtr-DELTA_PHYS;
   If FdwFieldDefTlbPtr<>0 Then
    FdwFieldDefTlbPos:=FdwFieldDefTlbPtr-DELTA_PHYS;
   If FdwMethodDefTlbPtr<>0 Then
    FdwMethodDefTlbPos:=FdwMethodDefTlbPtr-DELTA_PHYS;
   If FdwDynMethodsTlbPtr<>0 Then
    FdwDynMethodsTlbPos:=FdwDynMethodsTlbPtr-DELTA_PHYS;
   If FdwClassNamePtr<>0 Then
    FdwClassNamePos:=FdwClassNamePtr-DELTA_PHYS;
end;

constructor TClassDumper.Create;
begin
  Inherited Create;

  FieldData:=TFieldData.Create;
  MethodData:=TMethodData.Create;

  FdwBSSOffset:=TList.Create;
  FdwBSSOffset.Add(nil);
  FdwHeapPtr:=TList.Create;
  FdwHeapPtr.Add(nil);
  FdwDATAPrt:=TList.Create;
  FdwDATAPrt.Add(nil);
end;

destructor TClassDumper.Destroy;
begin
  FieldData.Free;
  MethodData.Free;
  FdwBSSOffset.Free;
  FdwHeapPtr.Free;
  FdwDATAPrt.Free;

  Inherited Destroy;
end;

procedure TClassDumper.Dump(dwSelfPtrPos: DWORD);
var b  : Byte;
    dw : DWORD;
    w : Word;
    DELTA_TBL : Byte;
begin
  FdwSelfPrtPos:=dwSelfPtrPos;

  {BOZA DeDeClasses.}PEStream.Seek(dwSelfPtrPos,soFromBeginning);

  // Reads SelfPtr
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwSelfPrt,4);

  // No selfpointers in Delphi 2
  If GlobDelphi2 then FdwSelfPrt:=0;

  // Reads ClassFlag
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FbClassFlag,1);

  If FbClassFlag<16 Then
   Begin
    // Reads ClassName length
    {BOZA DeDeClasses.}PEStream.ReadBuffer(b,1);
    SetLength(FsClassName,b);

    // Reads ClassName
    {BOZA DeDeClasses.}PEStream.ReadBuffer(FsClassName[1],b);
   End;

  // Reads VMT RVA
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwVMTPtr,4);
  IsInDataSection:=IsInData(FdwVMTPtr);

  {BOZA DeDeClasses.}PEStream.ReadBuffer(dw,4);

  // Reads Flag
  {BOZA DeDeClasses.}PEStream.ReadBuffer(w,2);

  ///////////////////////////////////////////
  // Support for other units and classes
  // 7 should be a class that has DFM resources
  if FbClassFlag<>7 Then Exit;
  ///////////////////////////////////////////

  // Reads UnitName length
  {BOZA DeDeClasses.}PEStream.ReadBuffer(b,1);
  SetLength(FsUnitName,b);

  // Reads UnitName
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FsUnitName[1],b);

  // Additive constant to RVA-Phys conversion for CODE section
  if IsInDataSection then
      DELTA_PHYS:=  PEHeader.IMAGE_BASE
                   +PEHeader.Objects[2].RVA
                   -PEHeader.Objects[2].PHYSICAL_OFFSET
  else
      DELTA_PHYS:=  PEHeader.IMAGE_BASE
                   +PEHeader.Objects[1].RVA
                   -PEHeader.Objects[1].PHYSICAL_OFFSET;

  // Gets The First Procedure RVA
  Repeat
    {BOZA DeDeClasses.}PEStream.ReadBuffer(b,1)
  Until not (b in [$00,$90,$8D,$40,$8B,$C0]);
  FdwFirstProcRVA:={BOZA DeDeClasses.}PEStream.Position+DELTA_PHYS;

  // Calculates VMT Position in executable
  FdwVMTPos:=FdwVMTPtr-DELTA_PHYS;

  // Moves to the beginning of the Class VMT
  DELTA_TBL:=76;
  If DelphiVersion='D3' Then DELTA_TBL:=64;
  If DelphiVersion='D2' Then DELTA_TBL:=44; {Offset to FielsDefTblPrtPos-4}
  {BOZA DeDeClasses.}PEStream.Seek(FdwVMTPos-DELTA_TBL,soFromBeginning);

  // Reads ClassInformation Data
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwVMTPtr2,4);
  if GlobCBuilder or GlobDelphi2 then FdwVMTPtr2:=FdwVMTPtr;
  If FdwVMTPtr<>FdwVMTPtr2 Then Exit;

  if not GlobDelphi2 then
    begin
      {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwInterfaceTlbPtr,4);
      {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwAutomationTlbPtr,4);
      {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwInitializationTlbPtr,4);
      {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwInformationTlbPtr,4);
    end;

  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwFieldDefTlbPtr,4);
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwMethodDefTlbPtr,4);

  if not GlobDelphi2 then
      {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwDynMethodsTlbPtr,4);

  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwClassNamePtr,4);
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwClassSize,4);
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwAncestorPtrPtr,4);
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwSafecallExceptionMethodPtr,4);
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwDefaultHandlerMethodPtr,4);
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwNewInstanceMethodPtr,4);
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwFreeInstanceMethodPtr,4);
  {BOZA DeDeClasses.}PEStream.ReadBuffer(FdwDestroyDestructorPtr,4);


  CalculatePositions;
  DumpFields;
  // Get DFM Offsets
  If DeDeMainForm.DFMFormList.IndexOf(FsClassName)<>-1
     Then FdwDFMOffset:=GetDFMOffset(FsClassName);

  // This should be called after all classes has been dumped
  // DumpMethods;
end;


procedure TClassDumper.DumpFields;
var  dw,i : DWORD;
     b : Byte;
     sName : String;
     w : Word;
begin
  If FdwFieldDefTlbPtr=0 Then Exit;
  If Not bELF then
  if Not IsInDataSection
     Then Begin If Not InCodeSection(FdwFieldDefTlbPtr) Then Exit End
     Else If Not InDataSection(FdwFieldDefTlbPtr) Then Exit;
     
  Try
  {BOZA DeDeClasses.}PEStream.Seek(FdwFieldDefTlbPos,soFromBeginning);