cpshellhook.pas

键盘钩子程序及控件, C++ Builder 和DELPHI可用

{*****************************************************************************
 * UnitName:  CPShellHook
 * Version:   1.0
 * Created:   24/03/2005
 * Updated:   24/03/2005
 * Purpose:   WH_SHELL Hook Dll
 * Developer: BITLOGIC Software
 * Email:     [e-mail]
 * WebPage:   http://www.bitlogic.co.uk
 *****************************************************************************}

{*****************************************************************************
  24/03/2005 First Release
*****************************************************************************}

unit CPShellHook;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, ExtCtrls, UHookVars;

type
TShellEvent = procedure(Sender: TObject; WindowID: HWnd) of object;
//TAppEvent = procedure(Sender: TObject; WindowID: HWnd; ProcesID, ThreadID: integer; AppTitle, AppPath: string) of object;

 { DLL Function Hook_Start }
TFncHookStart = function(LicenceCode: string; WinHandle: HWND; MsgToSend: DWORD): boolean; stdcall;
 { DLL Function Hook_Stop }
TFncHookStop = function: boolean; stdcall;
 { DLL Function Hook_GetData }
TFncHookGetData = function: string; stdcall;
 { DLL Function Hook_UpdateHook }
TFncHookUpdateHook = function(): boolean; stdcall;

 TCPShellHook = Class(TComponent)
  private
   FEnabled: boolean;
   FLicenceCode: string;
   FWindowHandle: HWND;
   FHookLibLoaded: boolean;
   FUserHookMsg: DWORD;
   FOnShellWindowCreated: TShellEvent;
   FOnShellWindowActivated: TShellEvent;
   FOnShellWindowDestroyed: TShellEvent;

   procedure WndProc(var Msg: TMessage);
   procedure HookMsg(var msg : TMessage); //message WM_SHELLHOOKMSG;
   procedure SetEnabled(const Value: Boolean);
   procedure SetLicenceCode(AValue: string);
   procedure SetUserHookMsg(const Value: DWORD);
  protected
   procedure DeallocateHWnd(Wnd: HWND);
   function LoadHookLib: boolean;
   function UnLoadHookLib: boolean;
  public
   Constructor Create(AOwner: TComponent); override;
   Destructor Destroy; override;
   function Start_ShellHook: boolean;
   function Stop_ShellHook: boolean;
  published
   property Enabled: Boolean read FEnabled write SetEnabled;
   property LicenceCode: string read FLicenceCode write SetLicenceCode;
   property UserHookMsg: DWORD read FUserHookMsg write SetUserHookMsg;
   property WindowHandle: HWND read FWindowHandle;
   property HookLibLoaded: Boolean read FHookLibLoaded;
   property OnShellWindowCreated: TShellEvent read FOnShellWindowCreated write FOnShellWindowCreated;
   property OnShellWindowActivated: TShellEvent read FOnShellWindowActivated write FOnShellWindowActivated;
   property OnShellWindowDestroyed: TShellEvent read FOnShellWindowDestroyed write FOnShellWindowDestroyed;
  end;

var
  DllHandle: HModule;
  PFncHookStart: TFncHookStart;
  PFncHookStop: TFncHookStop;
  PFncHookGetData: TFncHookGetData;
  PFncHookUpdateHook: TFncHookUpdateHook;

implementation

procedure TCPShellHook.SetLicenceCode(AValue: string);
begin
if AValue = FLicenceCode then exit;
FLicenceCode := AValue;
end;

constructor TCPShellHook.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 {if not (csDesigning in ComponentState) then}
FEnabled := False;
FWindowHandle := Classes.AllocateHWnd(WndProc);
FUserHookMsg := RegisterWindowMessage(MMFName);//WM_SHELLHOOKMSG;
FHookLibLoaded := False;
end;

{ Modified version of Classes.DeallocateHwnd }
procedure TCPShellHook.DeallocateHWnd(Wnd: HWND);
var
  Instance: Pointer;
begin
  Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
  if Instance <> @DefWindowProc then SetWindowLong(Wnd, GWL_WNDPROC, Longint(@DefWindowProc));
  FreeObjectInstance(Instance);
  DestroyWindow(Wnd);
end;

function TCPShellHook.LoadHookLib: boolean;
begin
result := false;
if FHookLibLoaded then exit;
DllHandle := LoadLibrary(PChar(HOOKLIBNAME));
if DllHandle <> 0 then
   begin
   { Get pointers to DLL Hook Functions }
   PFncHookStart := GetProcAddress(DllHandle, 'ShellHook_Start');
   PFncHookStop := GetProcAddress(DllHandle, 'ShellHook_Stop');
   PFncHookGetData := GetProcAddress(DllHandle, 'ShellHook_GetData');
   PFncHookUpdateHook := GetProcAddress(DllHandle, 'ShellHook_UpdateHook');
   if Assigned(PFncHookStart) and Assigned(PFncHookStop) and Assigned(PFncHookGetData) and Assigned(PFncHookUpdateHook) then
      begin
      FHookLibLoaded := True;
      result := true;
      end else FreeLibrary(DllHandle);
   end;
end;

function TCPShellHook.UnloadHookLib: boolean;
begin
result := false;
if DllHandle <> 0 then
   begin
   FreeLibrary(DllHandle);
   FHookLibLoaded := false;
   result := true;
   end;
End;

destructor TCPShellHook.Destroy;
begin
Try
Stop_ShellHook;
Finally
DeallocateHWnd(FWindowHandle);
End;
inherited Destroy;
end;

procedure TCPShellHook.SetEnabled(const Value: Boolean);
begin
  if Value = FEnabled then exit;
  FEnabled := Value;
  if Value then Start_ShellHook else Stop_ShellHook;
end;

function TCPShellHook.Start_ShellHook: boolean;
begin
Result := False;
if FEnabled then Exit;
if Not LoadHookLib then
   begin
   Raise Exception.Create('Cannot Load HookLib File: '+HOOKLIBNAME);
   exit;
   end;
if PFncHookStart(FLicenceCode,FWindowHandle,FUserHookMsg) then begin
   FEnabled := True;
   Result := True;
   end;
end;

procedure TCPShellHook.SetUserHookMsg(const Value: DWORD);
begin
//if FEnabled then exit;
if Value = FUserHookMsg then exit;
FUserHookMsg := Value;
end;

function TCPShellHook.Stop_ShellHook: boolean;
begin
Result := False;
if Not FEnabled then exit;
FEnabled := False;
Try
PFncHookStop;
Finally
UnloadHookLib;
Result := True;
End;
end;

procedure TCPShellHook.WndProc(var Msg: TMessage);
begin
if Msg.Msg = FUserHookMsg then
     try
     HookMsg(Msg);
     except
     //Application.HandleException(Self);
     end
  else Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

procedure TCPShellHook.HookMsg(var msg : TMessage);
begin
 case msg.LParam of
   HSHELL_ACTIVATESHELLWINDOW:;
   HSHELL_GETMINRECT:;
   HSHELL_LANGUAGE:;
   HSHELL_REDRAW:;
   HSHELL_TASKMAN:;
   HSHELL_WINDOWACTIVATED: if Assigned(FOnShellWindowActivated) then FOnShellWindowActivated(Self,msg.WParam);
   HSHELL_WINDOWCREATED: if Assigned(FOnShellWindowCreated) then FOnShellWindowCreated(Self,msg.WParam);
   HSHELL_WINDOWDESTROYED: if Assigned(FOnShellWindowDestroyed) then FOnShellWindowDestroyed(Self,msg.WParam);
 end;
end;

initialization

finalization
 if DllHandle <> 0 then FreeLibrary(DllHandle);

end.