侦听一个应用程序是否在运行的消息怎么处理,请教了
解决方案 »
- 请教xml文件读取问题
- 在delphi中怎样测试网络是否通畅
- 为什么我在D7中安装了Indy10 后,编译程序的时候,系统报错!在线等哈…………………………
- “客户端发送一段文本,然后收到服务器端的应答文本”,谁有例子啊?
- ★★请问turbo pascal 7.0中的清屏命令是什么?就像QB中的CLS命令。
- 关于Access数据库联接。。。急急啊。
- 心情很重,很郁闷,很无奈,也很失落,呵呵。。。。
- 提示:FILEID没有用到。请问怎样改?
- 图标提取器1.0源代码发布,http://icnw.myrice.com或http://icnwgreen.go.163.com !
- 关于QUERY的问题???????
- 字符串提取问题,在先等候
- 请教一个安装的问题
在Windows系统中提供了一种系统消息挂钩的(Message hook)功能,使用消息挂钩,可以实时监视处理系统中的各种消息。很多鼠标增强软件就是利用消息挂钩来拦截所有的鼠标消息进行处理的。
要设置鼠标消息挂钩,一般先建立一个使用鼠标消息挂钩的动态连接库(DLL)文件,然后就可以在其它程序中使用这个DLL文件处理鼠标消息。
下面的程序介绍通过鼠标消息挂钩监视鼠标消息,从而实现类似于一些鼠标增强软件一样的使窗口上下左右滚动的功能。1.建立动态连接库
选择菜单 File|New ,选择DLL产生一个DLL模版,保存为 MHook.Dpr
//MHook.Dpr源程序
library MHook;uses
SysUtils,
Classes,
hkproc in 'hkproc.pas';exports
EnableMouseHook,
DisableMouseHook;begin
hNextHookProc:=0;
procSaveExit:=ExitProc;
ExitProc:=@HotKeyHookExit;
end.再选择菜单 File|New ,选择Unit建立一个Pas文件,保存为 HKProc.pas
//HKProc.pas源程序
unit hkproc;interface
uses
Windows,Messages;
const
Move_Up = 0;Move_Down=1;
Move_Left=2;
Move_Right=3;
var
hNextHookProc:HHook;
procSaveExit:Pointer;
M_Direct:Integer;
LPoint:TPoint;
NowWindow:Integer;function MouseProc(iCode:Integer;wParam:WPARAM;
lParam:Pointer):LRESULT; stdcall;export;
function EnableMouseHook(WndHandle:integer):BOOL;export;function DisableMouseHook:BOOL;export;
function GetDirect(FPoint : TPoint;LPoint : TPoint):integer;
procedure HotKeyHookExit;far; implementation//GetDirect函数根据光标的移动决定窗口滚动的方向。
function GetDirect(FPoint : TPoint;LPoint : TPoint):integer;
var
iWidth,iHeight:integer;
begin
iWidth:=LPoint.x-FPoint.x;
iHeight:=lPoint.y-FPoint.y;
Result:=-1;if ((iWidth=0)or(iHeight=0))then
exit;if ((abs(iWidth) div abs(iHeight))>=2) then
if iWidth<0 then //Move to left
Result:=Move_Left
else
Result:=Move_Rightelse if ((abs(iHeight) div abs(iWidth))>=2) then
if iHeight<0 then //Move to top
Result:=Move_Up
else
Result:=Move_Down;end;function MouseProc(iCode:Integer;wParam:WPARAM;
lParam:Pointer):LRESULT; stdcall;export;
var
pMouse:^MOUSEHOOKSTRUCT;
l:integer;
begin
//如果用户按下鼠标右键同时Scroll Lock键为按下状态则
//滚动窗口。
if ((wParam=WM_RBUTTONDOWN) and Boolean(GetKeyState(145))) then
begin
pMouse:=lParam;
l:=GetDirect(lPoint,pMouse.pt);
if l>=0 then
M_Direct:=l;
lPoint:=pMouse.pt;NowWindow:=WindowFromPoint(lPoint);
if M_Direct=Move_Up then
SendMessage(NowWindow,WM_VSCROLL,SB_PAGEUP,0)
else if M_Direct=Move_Down thenSendMessage(NowWindow,WM_VSCROLL,SB_PAGEDOWN,0)
else if M_Direct=Move_Left then
SendMessage(NowWindow,WM_HSCROLL,SB_PAGELEFT,0)
else if M_Direct=Move_Right then
SendMessage(NowWindow,WM_HSCROLL,SB_PAGERIGHT,0);
Result:=1;
exit;
end
else if ((wParam=WM_RBUTTONUP) and Boolean(GetKeyState(145))) then
Result:=1
else
begin
Result:=0;
if iCode<0 then
begin
Result:=CallNextHookEx(hNextHookProc,iCode,wParam,
integer(lParam));
Exit;
end;
end;
end;function EnableMouseHook(WndHandle:integer):BOOL;export;
begin
GetCursorPos(lPoint);
Result:=False;
if hNextHookProc<>0 then
exit;
//设置Mouse hook
hNextHookProc:=SetWindowsHookEx(WH_MOUSE,@MouseProc,
Hinstance,0);
Result:=hNextHookProc<>0;
end;function DisableMouseHook:BOOL;export;
begin
if hNextHookProc<>0 then
begin
UnHookWindowsHookEx(hNextHookProc);
hNextHookProc:=0;
end;
Result:=hNextHookProc=0;
end;procedure HotKeyHookExit;
begin
if hNextHookProc<>0 then
DisableMouseHook;
ExitProc:=procSaveExit;
end;end.
在菜单中选择 Project|Build MHook建立DLL文件。2.建立程序调用动态连接库
在这里我们还是使用Delphi建立程序,当然也可以使用诸如VB等调用动态连接库。
在菜单中选 File|New Application建立一个新程序,将工程文件保存为Project1.dpr//project1的源程序
program Project1;uses
Forms,
Sample1 in 'Sample1.pas' {Form1};{$R *.RES}begin
Application.Initialize;
//隐藏窗口
Application.ShowMainForm := False;Application.CreateForm(TForm1, Form1);
Application.Run;
end. 将Form1的源程序文件保存成Sample1.pas//Form1的源程序
unit Sample1;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus, ImgList,ShellApi, ExtCtrls;const
WM_ICONMESSAGE=WM_USER+$100;
type
TForm1 = class(TForm)procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
procedure WMBarIcon(var Message:TMessage);message WM_ICONMESSAGE;publicend;function EnableMouseHook(WndHandle:integer):BOOL;external 'MHook.DLL';
function DisableMouseHook:BOOL;external'MHook.DLL';var
Form1: TForm1;implementation{$R *.DFM}
procedure TForm1.WMBarIcon (var Message:TMessage);
begin
//用户双击任务栏图标则关闭程序
if Message.LParam = WM_LBUTTONDBLCLK then
close;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
lpData:PNotifyIconData;
begin
//删除任务栏图标
lpData := new(PNotifyIconDataA);
lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
lpData.Wnd := Form1.Handle;
lpData.hIcon := Form1.Icon.Handle;
lpData.uCallbackMessage := WM_ICONMESSAGE;
lpData.uID :=0;
lpData.szTip := '鼠标演示';
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_DELETE,lpData);
dispose(lpData);
//解除Mouse hook
DisableMouseHook;
end;procedure TForm1.FormCreate(Sender: TObject);
var
lpData:PNotifyIconData;
begin
EnableMouseHook(Form1.Handle);
Form1.Visible := False;
lpData := new(PNotifyIconDataA);
lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
lpData.Wnd := Form1.Handle;
lpData.hIcon := Form1.Icon.Handle;
lpData.uCallbackMessage := WM_ICONMESSAGE;
lpData.uID :=0;
lpData.szTip := '鼠标演示';
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_ADD,lpData);
dispose(lpData);
end;end.