{
Window control message hook component --- by Liu Yang 2002.8.19
}
unit WindowHook;interfaceuses
Windows, Messages, SysUtils, Classes, Controls;type
TWindowHook = class(TComponent)
private
{ Private declarations }
FControl: TWinControl;
FActive: Boolean;
FHandle: THandle;
FOnControlMessage : TWndMethod;
OldAppProc, NewAppProc: Pointer; // Procedure variables
procedure HookControl;
procedure UnhookControl;
procedure HookProc(var Msg: TMessage);
procedure SetActive(Value: boolean);
procedure SetControlHandle(AHandle: THandle);
procedure SetControl(AControl: TWinControl);
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
published
{ Published declarations }
property Active : boolean read FActive write SetActive default false;
property Control : TWinControl read FControl write SetControl;
property ControlHandle : THandle read FHandle write SetControlHandle;
property OnControlMessage : TWndMethod read FOnControlMessage write FOnControlMessage;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents( 'Custom', [TWindowHook]);
end;{ TWindowHook }constructor TWindowHook.Create(AOwner: TComponent);
begin
inherited;
FActive:=false;
FHandle:=0;
end;destructor TWindowHook.Destroy;
begin
Active:=false;
inherited;
end;procedure TWindowHook.HookControl;
begin
// Hook the control
OldAppProc := Pointer(GetWindowLong(FHandle, GWL_WNDPROC));
NewAppProc := Classes.MakeObjectInstance(HookProc);
SetWindowLong(FHandle, GWL_WNDPROC, LongInt(NewAppProc));
end;procedure TWindowHook.HookProc(var Msg: TMessage);
begin
if Assigned(FOnControlMessage) then FOnControlMessage(Msg);
// Pass the message on
Msg.Result := CallWindowProc(OldAppProc, FHandle,
Msg.Msg, Msg.wParam, Msg.lParam);
end;procedure TWindowHook.SetActive(Value: boolean);
begin
if Value<>FActive then
begin
if Not IsWindow(FHandle) then
begin
if Assigned(FControl) and (FControl<>nil) then SetControlHandle(FControl.Handle);
if Not IsWindow(FHandle) then Exit;
end;
if Value
then HookControl
else UnHookControl;
FActive:=Value;
end;
end;procedure TWindowHook.SetControl(AControl: TWinControl);
begin
if AControl<>FControl then
begin
if Assigned(AControl) and (AControl<>nil) then SetControlHandle(AControl.Handle);
FControl:=AControl;
end;
end;procedure TWindowHook.SetControlHandle(AHandle: THandle);
begin
if FHandle<>AHandle then
if IsWindow(AHandle)
then begin Active:=false; FHandle:=AHandle; end
else FHandle:=0;
end;procedure TWindowHook.UnhookControl;
begin
// unook the control
if Assigned(OldAppProc) then
SetWindowLong(FHandle, GWL_WNDPROC, LongInt(OldAppProc));
if Assigned(NewAppProc) then
Classes.FreeObjectInstance(NewAppProc);
NewAppProc := nil;
OldAppProc := nil;
end;end.2:Hook API,可以监控系统所有的消息的
Window control message hook component --- by Liu Yang 2002.8.19
}
unit WindowHook;interfaceuses
Windows, Messages, SysUtils, Classes, Controls;type
TWindowHook = class(TComponent)
private
{ Private declarations }
FControl: TWinControl;
FActive: Boolean;
FHandle: THandle;
FOnControlMessage : TWndMethod;
OldAppProc, NewAppProc: Pointer; // Procedure variables
procedure HookControl;
procedure UnhookControl;
procedure HookProc(var Msg: TMessage);
procedure SetActive(Value: boolean);
procedure SetControlHandle(AHandle: THandle);
procedure SetControl(AControl: TWinControl);
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner: TComponent); override;
Destructor Destroy; override;
published
{ Published declarations }
property Active : boolean read FActive write SetActive default false;
property Control : TWinControl read FControl write SetControl;
property ControlHandle : THandle read FHandle write SetControlHandle;
property OnControlMessage : TWndMethod read FOnControlMessage write FOnControlMessage;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents( 'Custom', [TWindowHook]);
end;{ TWindowHook }constructor TWindowHook.Create(AOwner: TComponent);
begin
inherited;
FActive:=false;
FHandle:=0;
end;destructor TWindowHook.Destroy;
begin
Active:=false;
inherited;
end;procedure TWindowHook.HookControl;
begin
// Hook the control
OldAppProc := Pointer(GetWindowLong(FHandle, GWL_WNDPROC));
NewAppProc := Classes.MakeObjectInstance(HookProc);
SetWindowLong(FHandle, GWL_WNDPROC, LongInt(NewAppProc));
end;procedure TWindowHook.HookProc(var Msg: TMessage);
begin
if Assigned(FOnControlMessage) then FOnControlMessage(Msg);
// Pass the message on
Msg.Result := CallWindowProc(OldAppProc, FHandle,
Msg.Msg, Msg.wParam, Msg.lParam);
end;procedure TWindowHook.SetActive(Value: boolean);
begin
if Value<>FActive then
begin
if Not IsWindow(FHandle) then
begin
if Assigned(FControl) and (FControl<>nil) then SetControlHandle(FControl.Handle);
if Not IsWindow(FHandle) then Exit;
end;
if Value
then HookControl
else UnHookControl;
FActive:=Value;
end;
end;procedure TWindowHook.SetControl(AControl: TWinControl);
begin
if AControl<>FControl then
begin
if Assigned(AControl) and (AControl<>nil) then SetControlHandle(AControl.Handle);
FControl:=AControl;
end;
end;procedure TWindowHook.SetControlHandle(AHandle: THandle);
begin
if FHandle<>AHandle then
if IsWindow(AHandle)
then begin Active:=false; FHandle:=AHandle; end
else FHandle:=0;
end;procedure TWindowHook.UnhookControl;
begin
// unook the control
if Assigned(OldAppProc) then
SetWindowLong(FHandle, GWL_WNDPROC, LongInt(OldAppProc));
if Assigned(NewAppProc) then
Classes.FreeObjectInstance(NewAppProc);
NewAppProc := nil;
OldAppProc := nil;
end;end.2:Hook API,可以监控系统所有的消息的
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货