Global Mouse Hook in Delphi

[m.rabee]

السلام عليكم

وجدت في احدى المدونات كود للاستفادة من الزر الاوسط للماوس في الويندوز ككل.
وهو يعمل بشكل ممتاز بإستثناء بعض البرامج مكتوبة بلغة Visual C++

اولا ملف DLL


library MiddleButton;

uses
Windows,
Messages;

const
MemMapFile ='Igor_thief';
type
PDLLGlobal = ^TDLLGlobal;
TDLLGlobal =packedrecord
HookHandle: HHOOK;
end;

var
GlobalData: PDLLGlobal;
MMF: THandle;

{$R *.res}

function HookProc(Code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
CurrWND: THandle;
begin
if Code <0then
begin
Result := CallNextHookEx(GlobalData^.HookHandle, Code, wParam, lParam);
exit;
end; //if

if (wParam = WM_NCMBUTTONDOWN) or (wParam = WM_MBUTTONDOWN) then
begin
CurrWND := PMouseHookStruct(lParam)^.hwnd;
CurrWND := GetAncestor(CurrWND, GA_ROOTOWNER);
SendMessage(CurrWND, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end; //if

Result := CallNextHookEx(GlobalData^.HookHandle, Code, wParam, lParam);
end;

procedure CreateGlobalHeap;
begin
MMF:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0,
SizeOf(TDLLGlobal), MemMapFile);

if MMF =0thenbegin
MessageBox(0, 'CreateFileMapping -', '', 0);
exit;
end;

GlobalData:= MapViewOfFile(MMF, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TDLLGlobal));
if GlobalData =nilthenbegin
// ***1085;***1077; ***1089;***1084;***1086;***1075;***1076;***1080; ***1089;***1086;***1079;***1076;***1072;***1090;** *1100; ***1086;***1090;***1086;***1073;***1088;***1072;** *1078;***1077;***1085;***1080;***1077;
CloseHandle(MMF);
MessageBox(0, 'MapViewOfFile -', '', 0);
end;
end;

procedure DeleteGlobalHeap;
begin
if GlobalData<>nilthen
UnmapViewOfFile(GlobalData);

if MMF<> INVALID_HANDLE_VALUE then
CloseHandle(MMF);
end;

procedure RunHook; stdcall;
begin
GlobalData^.HookHandle:= SetWindowsHookEx(WH_MOUSE, @HookProc, HInstance, 0);
if GlobalData^.HookHandle = INVALID_HANDLE_VALUE then
begin
MessageBox(0, 'Error :)' , '' , MB_OK);
Exit;
end;
end;

procedure KillHook; stdcall;
begin
if (GlobalData<>nil) and (GlobalData^.HookHandle<>INVALID_HANDLE_VALUE) then
UnhookWindowsHookEx(GlobalData^.HookHandle);
end;

procedure DLLEntry(dwReason: DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH: CreateGlobalHeap;
DLL_PROCESS_DETACH: DeleteGlobalHeap;
end;
end;

exports
KillHook,
RunHook;

begin
DLLProc:= @DLLEntry;
DLLEntry(DLL_PROCESS_ATTACH);
end.

طريقة الاستخددام في دلفي




unit RunMiddleButton;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
TfrmMain = class(TForm)
btnRunHook: TButton;
btnKillHook: TButton;
procedure btnRunHookClick(Sender: TObject);
procedure btnKillHookClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

procedure RunHook; stdcall; external 'MiddleButton.dll' name 'RunHook';
procedure KillHook; stdcall; external 'MiddleButton.dll' name 'KillHook';

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.btnRunHookClick(Sender: TObject);
begin
RunHook;
end;

procedure TfrmMain.btnKillHookClick(Sender: TObject);
begin
KillHook;
end;

end.




اتمنى ممن لديه فكرة عن كيفية تعديل هذا الكود ليعمل مع كل النوافذ والبرامج
افادتنا
ولكم الشكر

[TF6M]

و عليكم السلام و رحمة الله و بركاته
1- راجع الدالة SetWindowsHookEx , التي تتيح لنا إظافة Hook الى الـ Hook queue
2- البارامتر الأخير DwThreadId ا:
The identifier of the thread with which the hook procedure is to be associated. If this parameter is zero, the hook procedure is associated with all existing threads running in the same desktop as the calling thread. 3- مثال بسيط :
function SetHookUp: Boolean; stdcall;
begin
CurrentHook := SetWindowsHookEx(WH_KEYBOARD //Hook Type .
, @HookProc // Hook Proc Address .
, Hinstance //dll Handle .
, GetTrgProcessId('Explorer.exe') //if 0 then it is a Global Hook ; No specified Thread !
);
if CurrentHook <> 0 then
Result := True else
Result := False;
end;بالتوفيق,,

[kachwahed]

Hook the Mouse Outside of your application
مثال من موقع delphi.about مشابه:
http://delphi.about.com/od/windowsshellapi/a/mousehook.htm
في المرفقات.