vmtutils.pas

这是个反向工程delphi的程序的全部源代码.能分析几乎所有的结构 Revendepro is a program to reverse engineer Delphi program. Reven

//    Author:          Python ([e-mail])
//    Version:         0.0.1.4
//    LastModified:    3-23-2000
//    LatestVersion:   http://thunder.prohosting.com/~pytho/
//    Copyright (c) 1999, 2000 Python. All rights reserved

unit VMTUtils;

interface

uses
  SysUtils, Classes, TypInfo;                                    

type
  EVMTError = class(Exception);

{ virtual methods methods }
function GetVirtualMethodCount(AClass: TClass): Integer;
function GetVirtualMethod(AClass: TClass; const Index: Integer): Pointer;
procedure SetVirtualMethod(AClass: TClass; const Index: Integer; const Method: Pointer);

{ dynamic methods methods }
type
  TDynamicIndexList = array[0..MaxInt div 16] of Word;
  PDynamicIndexList = ^TDynamicIndexList;
  TDynamicAddressList = array[0..MaxInt div 16] of Pointer;
  PDynamicAddressList = ^TDynamicAddressList;

function GetDynamicMethodCount(AClass: TClass): Integer;
function GetDynamicIndexList(AClass: TClass): PDynamicIndexList;
function GetDynamicAddressList(AClass: TClass): PDynamicAddressList;
function HasDynamicMethod(AClass: TClass; Index: Integer): Boolean;
function GetDynamicMethod(AClass: TClass; Index: Integer): Pointer;

{ init table methods }
function GetInitTable(AClass: TClass): PTypeInfo;

{ field table methods }

type
  TFieldEntry = packed record
    OffSet: Integer;
    IDX: Word;
    Name: ShortString;
  end;
  PFieldEntry = ^TFieldEntry;

  TFieldClassTable = packed record
    Count: Smallint;
    Classes: array[0..8191] of ^TPersistentClass;
  end;
  PFieldClassTable = ^TFieldClassTable;

  TFieldTable = packed record
    EntryCount: Word;
    FieldClassTable: PFieldClassTable;
    FirstEntry: TFieldEntry;
   {Entries: array[1..65534] of TFieldEntry;}
  end;
  PFieldTable = ^TFieldTable;

function GetFieldTable(AClass: TClass): PFieldTable;

{ method table }

type
  TMethodEntry = packed record
    EntrySize: Word;
    Address: Pointer;
    Name: ShortString;
  end;
  PMethodEntry = ^TMethodEntry;

  TMethodTable = packed record
    Count: Word;
    FirstEntry: TMethodEntry;
   {Entries: array[1..65534] of TMethodEntry;}
  end;
  PMethodTable = ^TMethodTable;

function GetMethodTable(AClass: TClass): PMethodTable;
function GetMethodEntry(MethodTable: PMethodTable; Index: Integer): PMethodEntry;

{ class parent methods }
procedure SetClassParent(AClass: TClass; NewClassParent: TClass);
function GetClassParent(AClass: TClass): TClass;

function IsClass(Address: Pointer): Boolean;

implementation

uses
  Windows;

resourcestring
  SMemoryWriteError = 'Error writing VMT memory (%s).';

type
  PLongint= ^Longint;
  PPointer = ^Pointer;

function GetVirtualMethodCount(AClass: TClass): Integer;
var
  BeginVMT: Longint;
  EndVMT: Longint;
  TablePointer: Longint;
  I: Integer;
begin
  BeginVMT := Longint(AClass);

  // Scan the offset entries in the class table for the various fields,
  // namely vmtIntfTable, vmtAutoTable, ..., vmtDynamicTable
  // The last entry is always the vmtClassName, so stop once we got there
  // After the last virtual method there is one of these entries.

  EndVMT := PLongint(LongInt(AClass) + vmtClassName)^;
  // Set iterator to first item behind VMT table pointer
  I := vmtSelfPtr + SizeOf(Pointer);
  repeat
    TablePointer := PLongint(Longint(AClass) + I)^;
    if (TablePointer <> 0) and (TablePointer >= BeginVMT) and
       (TablePointer < EndVMT) then
      EndVMT := Longint(TablePointer);
    Inc(I, SizeOf(Pointer));
  until I >= vmtClassName;

  Result := (EndVMT - BeginVMT) div SizeOf(Pointer);
end;

function GetVirtualMethod(AClass: TClass; const Index: Integer): Pointer;
begin
  Result := PPointer(Integer(AClass) + Index * SizeOf(Pointer))^;
end;

procedure SetVirtualMethod(AClass: TClass; const Index: Integer; const Method: Pointer);
var
  WrittenBytes: DWORD;
  PatchAddress: Pointer;
begin
  PatchAddress := PPointer(Integer(AClass) + Index * SizeOf(Pointer))^;

  //! StH: WriteProcessMemory IMO is not exactly the politically correct approach;
  // better VirtualProtect, direct patch, VirtualProtect
  if not WriteProcessMemory( GetCurrentProcess,
                             PatchAddress, @Method,
                             SizeOf(Pointer), WrittenBytes) then
  begin
    raise EVMTError.CreateFmt(SMemoryWriteError, [SysErrorMessage(GetLastError)]);
  end;

  if WrittenBytes <> SizeOf(Pointer) then
    raise EVMTError.CreateFmt(SMemoryWriteError, [IntToStr(WrittenBytes)]);

  // make sure that everything keeps working in a dual processor setting
  FlushInstructionCache(GetCurrentProcess, PatchAddress, SizeOf(Pointer));
end;

{ Dynamic method routines }

type
  TvmtDynamicTable = packed record
    Count: Word;
   {IndexList: array[1..Count] of Word;
    AddressList: array[1..Count] of Pointer;}
  end;

function GetDynamicMethodCount(AClass: TClass): Integer;
asm
       MOV     EAX, [EAX].vmtDynamicTable
       TEST    EAX, EAX
       JE      @@exit
       MOVZX   EAX, Word ptr [EAX]
@@exit:
end;

function GetDynamicIndexList(AClass: TClass): PDynamicIndexList;
asm
       MOV      EAX, [EAX].vmtDynamicTable
       ADD      EAX, 2
end;

function GetDynamicAddressList(AClass: TClass): PDynamicAddressList;
asm
       MOV      EAX, [EAX].vmtDynamicTable
       MOVZX    EDX, Word ptr [EAX]
       ADD      EAX, EDX
       ADD      EAX, EDX
       ADD      EAX, 2
end;

function HasDynamicMethod(AClass: TClass; Index: Integer): Boolean;
// Mainly copied from System.GetDynaMethod
asm
        { ->    EAX     vmt of class            }
        {       DX      dynamic method index    }

        PUSH    EDI
        XCHG    EAX,EDX
        JMP     @@haveVMT
@@outerLoop:
        MOV     EDX,[EDX]
@@haveVMT:
        MOV     EDI,[EDX].vmtDynamicTable
        TEST    EDI,EDI
        JE      @@parent
        MOVZX   ECX,word ptr [EDI]
        PUSH    ECX
        ADD     EDI,2
        REPNE   SCASW
        JE      @@found
        POP     ECX
@@parent:
        MOV     EDX,[EDX].vmtParent
        TEST    EDX,EDX
        JNE     @@outerLoop
        MOV     EAX, 0
        JMP     @@exit

@@found:
        POP     EAX
        MOV     EAX, 1
@@exit:
        POP     EDI
end;

function GetDynamicMethod(AClass: TClass; Index: Integer): Pointer;
asm
  call System.@FindDynaClass
end;

{ Interface table methods }

{ Init table methods }

function GetInitTable(AClass: TClass): PTypeInfo;
asm
       MOV    EAX, [EAX].vmtInitTable
end;

{ Field Table methods }

function GetFieldTable(AClass: TClass): PFieldTable;
asm
      MOV     EAX, [EAX].vmtFieldTable
end;

{ Method Table }

function GetMethodTable(AClass: TClass): PMethodTable;
asm
        MOV     EAX, [EAX].vmtMethodTable
end;

function GetMethodEntry(MethodTable: PMethodTable; Index: Integer): PMethodEntry;
begin
  Result := Pointer(Cardinal(MethodTable) +2);
  for Index := Index downto 1 do
    Inc(Cardinal(Result), Result^.EntrySize);
end;

{ Class Parent methods }

procedure SetClassParent(AClass: TClass; NewClassParent: TClass);
var
  WrittenBytes: DWORD;
  PatchAddress: Pointer;
begin
  PatchAddress := PPointer(Integer(AClass) + vmtParent)^;

  //! StH: WriteProcessMemory IMO is not exactly the politically correct approach;
  // better VirtualProtect, direct patch, VirtualProtect
  if not WriteProcessMemory( GetCurrentProcess,
                             PatchAddress, @NewClassParent,
                             SizeOf(Pointer), WrittenBytes) then
  begin
    raise EVMTError.CreateFmt(SMemoryWriteError, [SysErrorMessage(GetLastError)]);
  end;

  if WrittenBytes <> SizeOf(Pointer) then
    raise EVMTError.CreateFmt(SMemoryWriteError, [IntToStr(WrittenBytes)]);

  // make sure that everything keeps working in a dual processor setting
  FlushInstructionCache(GetCurrentProcess, PatchAddress, SizeOf(Pointer));
end;

function GetClassParent(AClass: TClass): TClass;
asm
        MOV     EAX,[AClass].vmtParent
        TEST    Result,EAX
        JE      @@exit
        MOV     EAX, [EAX]
@@exit:
end;

function IsClass(Address: Pointer): Boolean;
asm
        CMP     Address, Address.vmtSelfPtr
        JNZ     @False
        MOV     Result, True
        JMP     @Exit
@False:
        MOV     Result, False
@Exit:
end;

end.