TObject.AfterSonstruction'ı diğer yordamlara yeniden yönlendirmekle ilgili sorunlar

Question

TObject.AfterConstruction kodunu kodun diğer bir yordamına yeniden yönlendirmeye çalışıyorum ancak bir süre sonra birçok özel durum yükselmeye başlıyor. Not: Bu tür bir yönlendirme yöntemini başka birçok çözümde kullanıyorum.

unit Unit109; 

interface 

uses 
    Windows; 

implementation 

uses 
    SyncObjs, SysUtils; 

type 
    PJump = ^TJump; 
    TJump = packed record 
    OpCode: Byte; 
    Distance: Pointer; 
    end; 

    TObjectHack = class(TObject) 
    public 
    procedure AfterConstruction; 
    end; 

function GetMethodAddress(AStub: Pointer): Pointer; 
const 
    CALL_OPCODE = $E8; 
begin 
    if PBYTE(AStub)^ = CALL_OPCODE then 
    begin 
    Inc(Integer(AStub)); 
    Result := Pointer(Integer(AStub) + SizeOf(Pointer) + PInteger(AStub)^); 
    end 
    else 
    Result := nil; 
end; 

procedure AddressPatch(const ASource, ADestination: Pointer); 
const 
    JMP_OPCODE = $E9; 
    SIZE = SizeOf(TJump); 
var 
    NewJump: PJump; 
    OldProtect: Cardinal; 
begin 
    if VirtualProtect(ASource, SIZE, PAGE_EXECUTE_READWRITE, OldProtect) then 
    begin 
    NewJump := PJump(ASource); 
    NewJump.OpCode := JMP_OPCODE; 
    NewJump.Distance := Pointer(Integer(ADestination) - Integer(ASource) - 5); 

    FlushInstructionCache(GetCurrentProcess, ASource, SizeOf(TJump)); 
    VirtualProtect(ASource, SIZE, OldProtect, @OldProtect); 
    end; 
end; 

procedure OldAfterConstruction; 
asm 
    call TObject.AfterConstruction; 
end; 

{ TCriticalSectionHack } 
procedure TObjectHack.AfterConstruction; 
begin 
end; 

initialization 
    AddressPatch(GetMethodAddress(@OldAfterConstruction), @TObjectHack.AfterConstruction); 

end. 

Belki AfterConstruction o diğer yola değişti olmalı ve VKT (= -28 vmtAfterConstruction) saklanır? gibi:

PatchCodeDWORD(PDWORD(Integer(Self) + vmtAfterConstruction), DWORD(@TObjectHack.AfterConstruction)); 


procedure PatchCodeDWORD(ACode: PDWORD; AValue: DWORD); 
var 
    LRestoreProtection, LIgnore: DWORD; 
begin 
    if VirtualProtect(ACode, SizeOf(ACode^), PAGE_EXECUTE_READWRITE, LRestoreProtection) then 
    begin 
    ACode^ := AValue; 
    VirtualProtect(ACode, SizeOf(ACode^), LRestoreProtection, LIgnore); 
    FlushInstructionCache(GetCurrentProcess, ACode, SizeOf(ACode^)); 
    end; 
end; 

Her iki yolu da denedim, hiç başarı göstermeden, birisi bana yardım edebilir mi?

bazı biri yaklaşımların bu tür hakkında okumak isterseniz:

• http://hallvards.blogspot.com.br/2007/05/hack17-virtual-class-variables-part-i.html
• http://hallvards.blogspot.com.br/2006/03/hack-8-explicit-vmt-calls.html
• http://hallvards.blogspot.com.br/2007/03/hack14-changing-class-of-object-at-run.html

TKS

Answer 1

EDITED - Şimdi artırmak için çalışıyoruz ve öğe sayısını azaltmak. Çalıştırmak için üniteyi dpr'nizin ilk birimi olarak koymak yeterlidir. Şimdi, sadece bazı yöntemleri optimize edip, istediğim çıktıları buraya koyacağım. (Postayı tekrar göndermeyeceğim, gerekli değil) Ama kullanmak isterseniz, hataları test etmek ve raporlamak için ücretsiz düştü.Bir basit testini koymak istiyorsanız, SaveInstancesToFile prosedürünü, uygulama yolunuzda sayaçların çıkışıyla bir test.txt dosyası oluşturur.

unit ObjectCounter; 

    { Develop by rodrigofrezino@gmail.com 
    Stackoverflow: http://stackoverflow.com/users/225010/saci 
    Please, any bug let me know} 

interface 

    procedure SaveInstancesToFile; 

implementation 

uses 
    Windows, SysUtils, Classes, TypInfo; 

type 

    PClassVars = ^TClassVars; 
    TClassVars = class(TObject) 
    private 
    class var ListClassVars: TList; 
    public 
    InstanceCount: integer; 
    BaseClassName: string; 
    constructor Create; 

    class procedure SaveToDisk; 
    end; 

    PJump = ^TJump; 
    TJump = packed record 
    OpCode: Byte; 
    Distance: Pointer; 
    end; 

    TObjectHack = class(TObject) 
    private 
    class procedure SetClassVars(AClassVars: TClassVars); 
    class function GetClassVars: TClassVars; 

    procedure IncCounter; 
    procedure DecCounter; 
    procedure OldFreeInstace; 
    public 
    class function InitInstance(Instance: Pointer): TObject; 
    end; 

var 
    FOldFreeInstance: Pointer; 

procedure SaveInstancesToFile; 
begin 
    TClassVars.SaveToDisk; 
end; 

function GetMethodAddress(AStub: Pointer): Pointer; 
const 
    CALL_OPCODE = $E8; 
begin 
    if PBYTE(AStub)^ = CALL_OPCODE then 
    begin 
    Inc(Integer(AStub)); 
    Result := Pointer(Integer(AStub) + SizeOf(Pointer) + PInteger(AStub)^); 
    end 
    else 
    Result := nil; 
end; 

procedure AddressPatch(const ASource, ADestination: Pointer); 
const 
    JMP_OPCODE = $E9; 
    SIZE = SizeOf(TJump); 
var 
    NewJump: PJump; 
    OldProtect: Cardinal; 
begin 
    if VirtualProtect(ASource, SIZE, PAGE_EXECUTE_READWRITE, OldProtect) then 
    begin 
    NewJump := PJump(ASource); 
    NewJump.OpCode := JMP_OPCODE; 
    NewJump.Distance := Pointer(Integer(ADestination) - Integer(ASource) - 5); 

    FlushInstructionCache(GetCurrentProcess, ASource, SizeOf(TJump)); 
    VirtualProtect(ASource, SIZE, OldProtect, @OldProtect); 
    end; 
end; 

procedure PatchCodeDWORD(ACode: PDWORD; AValue: DWORD); 
var 
    LRestoreProtection, LIgnore: DWORD; 
begin 
    if VirtualProtect(ACode, SizeOf(ACode^), PAGE_EXECUTE_READWRITE, LRestoreProtection) then 
    begin 
    ACode^ := AValue; 
    VirtualProtect(ACode, SizeOf(ACode^), LRestoreProtection, LIgnore); 
    FlushInstructionCache(GetCurrentProcess, ACode, SizeOf(ACode^)); 
    end; 
end; 

procedure OldAfterConstruction; 
asm 
    call TObject.InitInstance; 
end; 

{ TCriticalSectionHack } 
procedure TObjectHack.DecCounter; 
begin 
    if (Self.ClassType <> TClassVars) then 
    Dec(GetClassVars.InstanceCount); 
    OldFreeInstace; 
end; 

class function TObjectHack.GetClassVars: TClassVars; 
begin 
    Result := PClassVars(Integer(Self) + vmtAutoTable)^; 
end; 

class procedure TObjectHack.SetClassVars(AClassVars: TClassVars); 
begin 
    AClassVars.BaseClassName := Self.ClassName; 
    PatchCodeDWORD(PDWORD(Integer(Self) + vmtAutoTable), DWORD(AClassVars)); 
end; 

procedure RegisterClassVarsSupport(const Classes: array of TObjectHack); 
var 
    LClass: TObjectHack; 
    LRestoreProtection: DWORD; 
    LIgnore: DWORD; 
    LVMT: Pointer; 
begin 
    for LClass in Classes do 
    if LClass.GetClassVars = nil then 
    begin 
     LClass.SetClassVars(TClassVars.Create); 

     //Change de mvt to object mvt 
     LVMT := PPointer(Integer(TObject) + vmtFreeInstance)^; 
     if VirtualProtect(LVMT, SizeOf(LVMT^), PAGE_EXECUTE_READWRITE, LRestoreProtection) then 
     begin 
     LVMT := @TObjectHack.DecCounter; 
     VirtualProtect(LVMT, SizeOf(LVMT^), LRestoreProtection, LIgnore); 
     FlushInstructionCache(GetCurrentProcess, LVMT, SizeOf(LVMT^)); 
     end; 
    end 
    else 
     raise Exception.CreateFmt('Class %s has automated section or duplicated registration.', [LClass.ClassName]); 
end; 

procedure TObjectHack.IncCounter; 
begin 
    if (Self.ClassType = TClassVars) then 
    Exit; 

    if GetClassVars = nil then 
    RegisterClassVarsSupport(Self); 

    Inc(GetClassVars.InstanceCount); 
end; 

class function TObjectHack.InitInstance(Instance: Pointer): TObject; 
asm 
     PUSH EBX 
     PUSH ESI 
     PUSH EDI 
     MOV  EBX,EAX 
     MOV  EDI,EDX 
     STOSD 
     MOV  ECX,[EBX].vmtInstanceSize 
     XOR  EAX,EAX 
     PUSH ECX 
     SHR  ECX,2 
     DEC  ECX 
     REP  STOSD 
     POP  ECX 
     AND  ECX,3 
     REP  STOSB 
     MOV  EAX,EDX 
     MOV  EDX,ESP 
@@0: MOV  ECX,[EBX].vmtIntfTable 
     TEST ECX,ECX 
     JE  @@1 
     PUSH ECX 
@@1: MOV  EBX,[EBX].vmtParent 
     TEST EBX,EBX 
     JE  @@2 
     MOV  EBX,[EBX] 
     JMP  @@0 
@@2: CMP  ESP,EDX 
     JE  @@5 
@@3: POP  EBX 
     MOV  ECX,[EBX].TInterfaceTable.EntryCount 
     ADD  EBX,4 
@@4: MOV  ESI,[EBX].TInterfaceEntry.VTable 
     TEST ESI,ESI 
     JE  @@4a 
     MOV  EDI,[EBX].TInterfaceEntry.IOffset 
     MOV  [EAX+EDI],ESI 
@@4a: ADD  EBX,TYPE TInterfaceEntry 
     DEC  ECX 
     JNE  @@4 
     CMP  ESP,EDX 
     JNE  @@3 
@@5: MOV  EBX,EAX 
     CALL TObjectHack.IncCounter 
     MOV  EAX,EBX 
     POP  EDI 
     POP  ESI 
     POP  EBX 
end; 

procedure TObjectHack.OldFreeInstace; 
asm 
    call FOldFreeInstance; 
end; 

procedure InitFreeInstance; 
begin 
    FOldFreeInstance := PPointer(Integer(TObject) + vmtFreeInstance)^; 
end; 

{ TClassVars } 

constructor TClassVars.Create; 
begin 
    ListClassVars.Add(Self); 
end; 

class procedure TClassVars.SaveToDisk; 
var 
    LStringList: TStringList; 
    i: Integer; 
begin        
    LStringList := TStringList.Create; 
    try 
    LStringList.Add('CLASS | NUMBER OF INSTANCES'); 
    for i := 0 to ListClassVars.Count -1 do 
     LStringList.Add(TClassVars(ListClassVars.Items[I]).BaseClassName + '|' + IntToStr(TClassVars(ListClassVars.Items[I]).InstanceCount)); 

    LStringList.SaveToFile(ExtractFilePath(ParamStr(0)) + 'test.txt'); 
    finally 
    FreeAndNil(LStringList); 
    end; 
end; 

initialization 
    TClassVars.ListClassVars := TList.Create; 
    InitFreeInstance; 
    AddressPatch(GetMethodAddress(@OldAfterConstruction), @TObjectHack.InitInstance); 

end.