我想找到一种方法来知道表单是在运行时创建(或销毁)的。这适用于 Delphi 或 fpc。非常感谢
PS:有没有办法检索所有对象的信息?
我想要一个事件告诉我一个新对象刚刚在运行时创建(或销毁)。
没有在创建或销毁对象时触发的内置事件。
因为我喜欢写代码钩子,所以我提供以下单元。这钩住了单元中的_AfterConstruction
方法System
。理想情况下,它应该使用蹦床,但我从未学会如何实现这些。如果您使用真正的挂钩库,您将能够做得更好。无论如何,这里是:
unit AfterConstructionEvent;
interface
var
OnAfterConstruction: procedure(Instance: TObject);
implementation
uses
Windows;
procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
OldProtect: DWORD;
begin
if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
begin
Move(NewCode, Address^, Size);
FlushInstructionCache(GetCurrentProcess, Address, Size);
VirtualProtect(Address, Size, OldProtect, @OldProtect);
end;
end;
type
PInstruction = ^TInstruction;
TInstruction = packed record
Opcode: Byte;
Offset: Integer;
end;
procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
NewCode: TInstruction;
begin
NewCode.Opcode := $E9;//jump relative
NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;
function System_AfterConstruction: Pointer;
asm
MOV EAX, offset System.@AfterConstruction
end;
function System_BeforeDestruction: Pointer;
asm
MOV EAX, offset System.@BeforeDestruction
end;
var
_BeforeDestruction: procedure(const Instance: TObject; OuterMost: ShortInt);
function _AfterConstruction(const Instance: TObject): TObject;
begin
try
Instance.AfterConstruction;
Result := Instance;
if Assigned(OnAfterConstruction) then
OnAfterConstruction(Instance);
except
_BeforeDestruction(Instance, 1);
raise;
end;
end;
initialization
@_BeforeDestruction := System_BeforeDestruction;
RedirectProcedure(System_AfterConstruction, @_AfterConstruction);
end.
分配一个处理程序,OnAfterConstruction
并且每当创建对象时都会调用该处理程序。
我把它作为练习留给读者添加一个OnBeforeDestruction
事件处理程序。
请注意,我并不是说这种方法是一件好事。我只是回答你问的直接问题。您可以自己决定是否要使用它。我知道我不会这样做!
在 MS Windows 中,您可以使用这个小模板挂钩您的进程事件:
{$mode objfpc}{$H+}
uses
Windows, JwaWinUser;
function ShellProc(nCode: longint; wParam: WPARAM; lParam: LPARAM): longint; stdcall;
var
wnd: HWND;
begin
Result := 0;
case nCode of
HSHELL_WINDOWCREATED:
begin
wnd := wParam;
// Check window
// Get task handle
// Get window icon
// Add task to the list
// Call event
end;
HSHELL_WINDOWDESTROYED:
begin
wnd := wParam;
// Check window
// Get task handle
// Get window icon
// Remove task to the list
// Call event
end;
HSHELL_LANGUAGE:
begin
// Get language
// Call event
end;
HSHELL_REDRAW:
begin
// Call event
end;
HSHELL_WINDOWACTIVATED:
begin
// Get language
// Call event
end;
//HSHELL_APPCOMMAND:
//begin
// { TODO 1 -ond -csys : Specify return value for this code }
// Result := -1;
//end;
end;
// Call next hook in the chain
Result := CallNextHookEx(
0,
nCode,
wParam,
lParam);
end;
var
FCallbackProc: HOOKPROC;
function InitShellHook(AProc: HOOKPROC): HHOOK; stdcall; export;
begin
FCallbackProc := AProc;
Result := SetWindowsHookEx(WH_SHELL, @ShellProc, 0, 0);
end;
procedure DoneShellHook(AHook: HHOOK); stdcall; export;
begin
UnhookWindowsHookEx(AHook);
end;
HSHELL_WINDOWCREATED 将通知您您的进程正在创建新窗口。
InitShellHook
用你的程序地址调用(见HOOCPROC
声明)。
使用TForm
'OnCreate
事件以任何你想要的方式通知你想要的人。