{
  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,可以监控系统所有的消息的