dedeclasses.pas

dede 的源代码 3.10b

unit DeDeClasses;
//////////////////////////
// Last Change: 03.X.2001
//////////////////////////

interface

uses Classes, Windows, DeDeConstants;

const
      DATA_FOR_PE_HEADER_OFFSET = $3C;
      PE_HEADER_SIZE = $F8;
      MAX_PE_PLUS_DELTA = $F;

Type TPEObjectBuffer = array [1..40] of Byte;


Type TPaternQuery = Class(TObject)
       public
         buffer : Array of Byte;
         mask   : Array of Boolean;
         size   : LongInt;
         procedure SetPattern(AsPattern : String);
         procedure SetString(AsString : String);
         function GetPattern : String;
         function GetByte(Index : LongInt) : Integer;
     End;

Type THeaderType = (htNone,htDFM);     

Type TPEStream = Class (TMemoryStream)
       protected
         FlBackupPos : Longint;
       public
         procedure ReadBufferA(var buffer : array of byte; size : Dword);
         procedure WriteBufferA(var buffer : array of byte; size : Dword);
         function ReadByte : Byte;
         function ReadWord : Word;
         function ReadDWord : DWord;
         function ReadByteA : Byte;
         function ReadWordA : Word;
         function ReadDWordA : DWord;
         function ReadWordF : Word;
         function ReadDWordF : DWord;
         function ReadWordFA : Word;
         function ReadDWordFA : DWord;
         function PatternMach(APattern : TPaternQuery) : Boolean;
         procedure DumpCodeToFile(FromO,ToO : DWORD; sFileName : String; HT : THeaderType);
         procedure BeginSearch;
         procedure EndSearch;
     End;

Type ThePEFile = Class(TObject)
       protected
          Stream : TPEStream;
       public
          sFileName : String;
          constructor Create(AsFileName : String);
          destructor Destroy; override;
          procedure Seek(Offset : DWord);
          procedure Read(var b1,b2,b3,b4 : Byte); overload;
          procedure Read(var b1,b2 : Byte); overload;
          procedure Read(var b1 : Byte); overload;
          procedure Write(b : Byte);
          function FilePos : Integer;
          function FileSize : Integer;
          property PEStream : TPEStream read Stream;
     End;

Type TPEObject = object
       DATA: TPEObjectBuffer;
       OBJECT_NAME : String;
       VIRTUAL_SIZE, RVA, PHYSICAL_OFFSET,
       PHYSICAL_SIZE, FLAGS : DWORD;
       PointerToRelocations,PointerToLinenumbers,
       NumberOfRelocations,NumberOfLinenumbers : DWORD;
       InfoAddress : DWORD;
       Procedure Process;
       Function DecodeFlags(AdwFlags : DWORD) : String;
       Procedure MakeBuffer;
     End;

Type TPEHeaderBuffer = array [1..PE_HEADER_SIZE+MAX_PE_PLUS_DELTA] of Byte;

Type TPEHeader = class (TObject)
       protected
         Procedure Process;
         Procedure ProcessObjects;
       public
         ELFDumped : Boolean;
         //DATA : TPEHeaderBuffer;
         PEPlusDelta : DWORD;
         PEHeaderOffset : DWORD;

         Signature : String;
         CPU : String;
         ObjectNum : Word;
         TimeStamp : DWORD;
         SymTblOffset : DWORD;
         SymNum : Word;
         OptionalPEType : String;
         NT_HDR_SIZE : Word;
         FLAGS : Array [1..16] of Boolean;
         wFlags : DWORD;
         LMAJOR_MINOR : String;
         SizeOfCode : DWORD;
         SizeOfInitializedData : DWORD;
         SizeOfUninitializedData : DWORD;
         RVA_ENTRYPOINT : DWORD;
         BaseOfCode,BaseOfData : DWORD;
         IMAGE_BASE: DWORD;
         OBJECT_ALIGN, FILE_ALIGN : DWORD;
         OSMAJOR_MINOR : DWORD;
         USERMAJOR_MINOR : DWORD;
         SUBSYSMAJOR_MINOR : DWORD;
         IMAGE_SIZE, HEADER_SIZE, FILE_CHECKSUM  : DWORD;
         SUBSYSTEM : String;
         DLL_FLAGS : String;
         STACK_RESERVE_SIZE, STACK_COMMIT_SIZE : DWORD;
         HEAP_RESERVE_SIZE, HEAP_COMMIT_SIZE : DWORD;
         LoaderFlags : DWORD;
         VA_ARRAY_SIZE : DWORD;

         EXPORT_TABLE_RVA, TOTAL_EXPORT_DATA_SIZE,
         IMPORT_TABLE_RVA, TOTAL_IMPORT_DATA_SIZE,
         RESOURCE_TABLE_RVA, TOTAL_RESOURCE_DATA_SIZE,
         EXCEPTION_TABLE_RVA, TOTAL_EXCEPTION_DATA_SIZE,
         SECURITY_TABLE_RVA, TOTAL_SECURITY_DATA_SIZE : DWORD;
         FIXUP_TABLE_RVA, TOTAL_FIXUP_DATA_SIZE,
         DEBUG_TABLE_RVA, TOTAL_DEBUG_DIRECTORIES,
         IMAGE_DESCRIPTION_RVA, TOTAL_DESCRIPTION_SIZE,
         MACHINE_SPECIFIC_RVA, MACHINE_SPECIFIC_SIZE,
         THREAD_LOCAL_STORAGE_RVA, TOTAL_TLS_SIZE : DWORD;
         Load_Config_Table_RVA, Load_Config_Table_Size : DWORD;
         Bound_Import_RVA, Bound_Import_Size : DWORD;
         IAT_RVA, IAT_Size : DWORD;
         Delay_Import_Descriptor_RVA, Delay_Import_Descriptor_Size : DWORD;
         COM_Runtime_Header_RVA, COM_Runtime_Header_Size : DWORD;
         Objects : Array [1..50] of TPEObject;
         Procedure Dump(PFile : ThePEFile);
         Procedure DumpELFFile(PFile : ThePEFile);
         Function GetPEObjectData(AsRVA : String; Var AiOffset, AiSize : LongInt) : Boolean;
         Function GetSectionIndex(AsSect : String) : Integer;
         Function GetSectionIndexByRVA(RVA: DWORD): Integer;
         Function GetSectionIndexEx(AsSect : String) : Integer;
         Destructor Destroy; override;
     End;

Type TResDirEntry = Record
       NAME_RVA, INTEGER_ID,
       DATA_ENTRY_RVA, SUBDIR_RVA : Word;
     End;


Type TPEResDirEntry = Object
       FLAGS, NameEntry, IDEntry : LongInt;
       DateTimeStamp : String;
       Version : String;
       Count : Integer;
       Entries : Array of TResDirEntry;
     End;

Type TPEResDir = Object
        DATA : Array of Byte;
        DirEntry : Array of TPEResDirEntry;
        Procedure Process;
     End;

Type TFixupBlockData = Record
        Offset, Size : DWORD;
     End;

Type TPEFixupTable = Object
       FileName : String;
       BlocksCount : Word;
       DATA : Array of TFixupBlockData;
       Procedure CollectInfo(ABaseOffset,ASize : DWord);
       Procedure GetData(AiBlock : Word; AList : TStrings);
     End;

Type TPEImportData = Object
       FileName : String;
       DLLCount, ProcCount : Integer;
       Procedure CollectInfo(APhysOffset,RVA : DWord; AList : TStrings);
     End;


Type TPETLSTable = Object
       FileName : String;
       START_DATA_BLOCK_VA,
       END_DATA_BLOCK_VA,
       INDEX_VA, CALLBACK_TABLE_VA : String;
       Procedure Process(PhysOffset : DWORD);
     End;

Type TExportFuncData = Record
       Name : String;
       Offset : String;
       Ordinal : LongInt;
       NameAddress : DWORD;
     End;

Type TPEExports = Object
        FileName : String;
        DATE_TIME_STAMP : String;
        VERSION : String;
        Name_RVA : String;
        Ordinal_Base : LongInt;
        Address_Table_Entries, Number_of_Name_Pointers : LongInt;
        Export_Address_Table_RVA,
        Name_Pointer_RVA,
        Ordinal_Table_RVA : String;
        FUNC_DATA : Array of TExportFuncData;
        Procedure Process(AdwAddress,ARVA : DWORD);
     End;


Function HexChar(Ab : Byte) : Char;
Function _Chr(Ab : Byte) : Char;
Function Chr1(Ab : Byte) : String;

// This var must not be created or freed !!!!
// If must be assigned from Application witch
// uses this unit. This application have to
// create and destroy PEFile !!!
Var PEFile : ThePEFile;


Type TOnSeek = Procedure(dw : DWORD) of Object;


Type TRVAConverter = Object
         ImageBase : DWORD;
         PhysOffset : DWORD;
         CodeRVA : DWORD;
         function GetRVA(AsPhys : DWORD) : DWORD; overload;
         function GetPhys(AsRVA : DWORD) : DWORD; overload;
         function GetRVA(AsPhys : String) : String; overload;
         function GetPhys(AsRVA : String) : String; overload;
     End;

Type TDFMProjectUnitEntrie = record
        Characteristic : Word;
        Name : String;
     end;


Type TDFMProjectHeader = Class(TObject)
        protected
        public
          FPASList : TStringList;
          FDFMList : TStringList;
          Characteristic1,Characteristic2 : DWORD;
          ProjectName : String;
          ProjectChar : WORD;
          UnitEntriesCount : WORD;
          UnitEntries : Array  of TDFMProjectUnitEntrie;
          Procedure Dump(PEStream : TPEStream; Offset : LongInt);
          Constructor Create;
          Destructor Destroy; override;
     end;

(*Type TDelphi4PE = Class (TObject)
       protected
         FImageBase, FCodeBase,FCodeRVA,FCodeRVASize,FPhysOffset,FEntryPoint : DWORD;
         FConverter : TRVAConverter;
         FOnSeek : TOnSeek;
         FsDir : String;
         FStandartDelphiUnits : TStringList;
         function Prepare : Integer;
         procedure FreeOpCodes;
       private
       public
         FMemFile : TPEStream;
         FDFMList : TStringList;
         FPASList : TStringList;
         FPASList1 : TStringList;
         FOpcodeList : TList;
         constructor Create;
         destructor Destroy; override;
         function IdentifyCompiler(Var AsOffset : String) : String;
         procedure LoadFile(AsFileName : String);
         procedure SetOffsets(ImageBase, CodeBase, CodeRVA, CodeRVASize, PhysOffset, EntryPoint: DWORD);
         procedure SetDirectory(sDir : String);
         property OnSeek : TOnSeek read FOnSeek write FOnSeek;
     End;
     *)

Type DWORD = LongWord;

Type TFieldRec = Class
        sName  : String;
        dwID   : DWORD;
        wFlag  : WORD;
     End;


Type TFieldData = Class
       protected
        Procedure ClearFields;
       public
        Count : Integer;
        Ptr   : DWORD;
        Fields : TList;
        Constructor Create;
        Destructor Destroy; override;
        Procedure AddField(Name : String; ID : DWORD; Flag : Word);
        Function GetFieldName(ID : DWORD) : String;
        Function GetFieldIdx(ID : DWORD) : Integer;
     End;

Type TMethodRec = Class
        sName  : String;
        dwRVA   : DWORD;
        wFlag  : WORD;
     End;


Type TMethodData = Class
       protected
        Procedure ClearMethods;
       public
        Count : Integer;
        Methods : TList;
        Constructor Create;
        Destructor Destroy;  override;
        Procedure AddMethod(Name : String; RVA : DWORD; Flag : Word);
        Function MethodIndexByRVA(RVA : DWORD) : Integer;
        Function ProcEntryPossible(RVA : DWORD) : Boolean;
     End;

Function GetDelphiVersion(PEFile : ThePEFile) : String;
Function GetDelphiVersionFromImports(sFileName : String; lImpOffset,lImpRVA : DWORD) : String;

var    GlobAbort : Boolean;
       GlobError : String;

//BOZA       PEStream : TPEStream;
       PEHeader : TPEHeader;
       ProcRefOffsets : TStringList;
       ProcRefNames : TStringList;
       DelphiVersion : String;
       GlobCBuilder : Boolean;
       GlobDelphi2  : Boolean;

       // moved here from MainUnit
       bDebug, bUserProcs, bBSS, bELF : Boolean;

////////////////////////////////////////////////////
//    Some functions needed for IDA MAP file export
// and loading .sym file into SoftIce
////////////////////////////////////////////////////
Function DeDeStrToIDAStr(sDeDeStr : String) : String;
function GetSoftIceDir : String;
function SoftIceIsActive : Boolean;


implementation

Uses SysUtils, Dialogs, Controls, HEXTools, IniFiles, DeDeRES, Registry,
     DeDeELFClasses;

{ TDelphi4PE }

(*
constructor TDelphi4PE.Create;
Var i : Integer;
begin
  Inherited Create;

  FOpcodeList:=TList.Create;

  FDFMList:=TStringList.Create;
  FPASList:=TStringList.Create;
  FPASList1:=TStringList.Create;

  FStandartDelphiUnits:=TStringList.Create;
  For i:=1 To iMAX_STANDART_UNITS_COUNT Do
    FStandartDelphiUnits.Add(arrPROJECT_STANDART_UNITS[i]);
end;

destructor TDelphi4PE.Destroy;
begin
  FDFMList.Free;
  FPASList.Free;
  FPASList1.Free;
  FStandartDelphiUnits.Free;

  FreeOpCodes;
  FOpcodeList.Free;

  Inherited Destroy;
end;


procedure TDelphi4PE.FreeOpCodes;
var i : Integer;
    inst : TStringList;
begin
  For i:=0 To FOpCodeList.Count-1 Do
    Begin
      inst:=TStringList(FOpCodeList[i]);
      inst.Free;
    End;
end;

function TDelphi4PE.IdentifyCompiler(var AsOffset: String): String;
Var i,j : Integer;
    Pat : TPaternQuery;
    bFound : Boolean;
begin
  // Seeking DFM Project Header
  For j:=1 To iCOMPILER_ID_COUNT Do
   Begin
      Pat:=TPaternQuery.Create;
      Try
        Pat.SetPattern(arrCOMPILER_IDS[j,1]);
        bFound:=False;
        FMemFile.BeginSearch;
        For i:=0 To FMemFile.Size-Pat.size+1 Do
         Begin
           FMemFile.Seek(i,soFromBeginning);
           bFound:=FMemFile.PatternMach(Pat);
           If bFound Then break;
         End;

        If bFound Then Begin
          Result:=arrCOMPILER_IDS[j,2];
          AsOffset:=DWORD2HEX(i);
          Break;
        End;

      Finally
        Pat.Free;
        FMemFile.EndSearch;
      End;
   End;

   If Not bFound
     Then Result:='';
end;

procedure TDelphi4PE.LoadFile(AsFileName: String);
begin

end;

function TDelphi4PE.Prepare: Integer;
begin
  Result:=0;
end;

procedure TDelphi4PE.SetDirectory(sDir: String);
begin
  FsDir:=sDir;
end;

procedure TDelphi4PE.SetOffsets(ImageBase, CodeBase, CodeRVA, CodeRVASize, PhysOffset, EntryPoint: DWORD);
begin
  FCodeBase:=CodeBase;
  FCodeRVA:=CodeRVA;
  FPhysOffset:=PhysOffset;
  FEntryPoint:=EntryPoint;
  FImageBase:=ImageBase;
  FCodeRVASize:=CodeRVASize;