Delphi 将待完工项目重新定向到其他程序的问题_Delphi_Delphi Xe

Delphi 将待完工项目重新定向到其他程序的问题

delphi

Delphi 将待完工项目重新定向到其他程序的问题,delphi,delphi-xe,Delphi,Delphi Xe,我正试图使用下面的代码将TObject.AfterConstruction重定向到另一个过程，但经过一段时间后，许多异常开始出现。注意：我使用这种重定向到许多其他解决方案 unit Unit109; interface uses Windows; implementation uses SyncObjs, SysUtils; type PJump = ^TJump; TJump = packed record OpCode: Byte; Distance

我正试图使用下面的代码将TObject.AfterConstruction重定向到另一个过程，但经过一段时间后，许多异常开始出现。注意：我使用这种重定向到许多其他解决方案

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.

可能后构造存储在VMT（vmtAfterConstruction=-28）中，必须以其他方式更改它？比如：

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;

我尝试了两种方法，都没有成功，有人能给我帮助吗

如果有人想了解这种方法：

Tks已编辑-正在增加和减少项目数量。要使其工作，只需将该单元作为dpr的第一个单元。现在，我将优化一些方法，并将我想要的输出放在这里。（我不会重新编辑帖子，不需要）但是，如果您想使用，可以自由地测试和报告错误。如果您想测试SaveInstancesToFile过程，我将一个simple输出，它将在应用程序路径中创建一个test.txt文件，并输出计数器

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.

单位对象计数器；
{按rodrigofrezino@gmail.com
堆栈溢出：http://stackoverflow.com/users/225010/saci
请告诉我任何错误}
接口
过程SaveInstancesToFile；
实施
使用
Windows、SysUtils、类、TypInfo；
类型
PClassVars=^TClassVars；
TClassVars=类（TObject）
私有的
类变量ListClassVars:TList；
公众的
InstanceCount：整数；
BaseClassName：字符串；
构造函数创建；
类过程SaveToDisk；
结束；
PJump=^TJump；
TJump=压缩记录
操作码：字节；
距离：指针；
结束；
TObjectHack=类（TObject）
私有的
类过程SetClassVars（AClassVars:TClassVars）；
类函数GetClassVars:TClassVars；
程序计数器；
程序计数器；
免费安装程序；
公众的
类函数InitInstance（实例：指针）：TObject；
结束；
变量
FOldFreeInstance：指针；
过程SaveInstancesToFile；
开始
TClassVars.SaveToDisk；
结束；
函数GetMethodAddress（AStub:Pointer）：指针；
常数
调用操作码=$E8；
开始
如果PBYTE（AStub）^=调用操作码，则
开始
Inc（整数（AStub））；
结果：=指针（整数（AStub）+SizeOf（指针）+PInteger（AStub）^；
结束
其他的
结果：=无；
结束；
过程地址补丁（const ASource，ADestination:Pointer）；
常数
JMP_操作码=$E9；
大小=SizeOf（TJump）；
变量
NewJump:PJump；
奥尔德：红衣主教；
开始
如果是VirtualProtect（源、大小、页面、执行、读写、OldProtect），则
开始
NewJump:=PJump（ASource）；
NewJump.OpCode:=JMP_操作码；
NewJump.Distance:=指针（整数（目标）-整数（源）-5）；
FlushInstructionCache（GetCurrentProcess，ASource，SizeOf（TJump））；
VirtualProtect（A来源、大小、OldProtect、@OldProtect）；
结束；
结束；
程序补丁代码DWORD（ACode:PDWORD；AValue:DWORD）；
变量
莱诺雷斯特保护公司：德沃德；
开始
如果虚拟保护（ACode，SizeOf（ACode^），PAGE\u EXECUTE\u READWRITE，LRestoreProtection），那么
开始
ACode^:=AValue；
虚拟保护（ACode，SizeOf（ACode^），LRestoreProtection，LIgnore）；
FlushInstructionCache（GetCurrentProcess，ACode，SizeOf（ACode^））；
结束；
结束；
施工程序；
asm
调用TObject.InitInstance；
结束；
{TCriticalSectionHack}
程序TObjectHack.DecCounter；
开始
如果是（Self.ClassType TClassVars），则
Dec（GetClassVars.InstanceCount）；
奥德弗里斯；
结束；
类函数TObjectHack.GetClassVars:TClassVars；
开始
结果：=PClassVars（整数（自）+vmtAutoTable）^；
结束；
类过程TObjectHack.SetClassVars（AClassVars:TClassVars）；
开始
AClassVars.BaseClassName:=Self.ClassName；
PatchCodeDWORD（PDWORD（整数（Self）+vmtAutoTable），DWORD（AClassVars））；
结束；
过程寄存器ClassVarsSupport（常量类：TObjectHack数组）；
变量
L类：TObjectHack；
LRestoreProtection:德沃德；
木矿石：德沃德；
LVMT：指针；
开始
在课堂上做什么
如果LClass.GetClassVars=nil，则
开始
LClass.SetClassVars（TClassVars.Create）；
//将de mvt更改为对象mvt
LVMT:=PPointer（整数（TObject）+vmtFreeInstance）^；
如果VirtualProtect（LVMT，SizeOf（LVMT^），PAGE\u EXECUTE\u READWRITE，LRestoreProtection），则
开始
LVMT:=@TObjectHack.DecCounter；
虚拟保护（LVMT、SizeOf（LVMT^）、LRestoreProtection、LIgnore）；
FlushInstructionCache（GetCurrentProcess，LVMT，SizeOf（LVMT^））；
结束；
结束
其他的
引发异常。CreateFmt（'类%s具有自动分区或重复注册'，[LClass.ClassName]）；
结束；
程序TObjectHack.IncCounter；
开始
如果（Self.ClassType=TClassVars），则
出口
如果GetClassVars=nil，则
注册ClassVarsSupport（自我）；
公司（GetClassVars.InstanceCount）；
结束；
类函数TObjectHack.InitInstance（实例：指针）：TObject；
asm
推EBX
推动ESI
推式电子数据交换
MOV-EBX，EAX
电子数据交换
斯托德
MOV ECX[EBX].vmtInstanceSize
异或EAX，EAX
推ECX
SHR-ECX，2
12月ECX
雷普斯托德
波普ECX
和ECX，3
代表STOSB
MOV-EAX，EDX
电能传输
@@0:MOV ECX[EBX].vmtIntfTable
测试ECX，ECX
JE@@1
推ECX
@@1:MOV EBX[EBX].VMT租金
测试EBX，EBX
JE@@2
MOV EBX，[EBX]
JMP@@0
@@2:CMP ESP，EDX
JE@@5
@@3:POP EBX
MOV ECX[EBX].TInterfaceTable.EntryCount
添加EBX，4
@@4:MOV ESI[EBX].TInterfaceEntry.VTable
测试ESI，ESI
JE@@4a
MOV EDI[EBX].TInterfaceEntry.IOOffset
MOV[EAX+EDI]，ESI
@@4a：添加EBX，键入TInterfaceEntry
12月ECX
JNE@@4
电子稳定程序
JNE@@3
@@5:MOV E