让LISP控制WINDOWS消息循环（给ACAD注入钩子）监控键盘鼠标消息

XDSoft · 发表于 2018-1-8 14:13:45

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

关于WINDOWS系统的消息循环可以网络搜索，参考文献。

WINDOWS系统的所有软件都是通过消息循环和系统交互，我们按下键盘或者移动鼠标，WINDOWS系统会把消息发送到AUTOCAD，AUTOCAD接受消息处理并返回信息给系统。

那AUTOCAD接受到的系统键盘消息，通过ARX的钩子相关函数，可以截获，这个消息应用程序处理后可以继续传给AUTOCAD后续操作，也可以截获，让AUTOCAD不知道有这个“消息”过来，AUTOCAD也就不能继续响应消息然后操作。
一般的钩子函数定义如下：

BOOL HOOK(MSG *pMsg)
{
switch(pMsg->message){
case WM_KEYDOWN:
case WM_SYSKEYDOWN:
if (...)
{
return TRUE; // TRUE 截获消息，不让AUTOCAD继续处理。
}
break;
}
return FALSE;// 返回FALSE，AUTOCAD可以继续接受该消息
}

那A/VLISP能不能也截获消息处理呢，不能，LISP没提供这样的功能。

下面通过XDRX API提供给LISP的自定义函数，来完成上面的操作。

API提供的“钩子”相关的函数有：

xdrx-hook-register
xdrx-hook-enable
xdrx-hook-status
xdrx-hook-remove
xdrx-hook-tracemouse
xdrx-hook-block-messageloop
xdrx-system-keystate
xdrx-system-ctrl-down
xdrx-system-ctrl-shift-down
xdrx-system-ctrl-alt-shift-down
xd::hook:register
xd::hook:enable
xd::hook:remove

xdrx-hook-block-messageloop函数的作用相当于上面说的return TRUE,终止消息继续给AUTOCAD。

LISP的典型钩子回调函数结构如下：

(defun hook (hwnd msg wparam lparam time pos)
;|
hwnd -- 窗口句柄
msg --- 消息
wparam -- 主参数
lparam ---- 第二参数
time ------- 发生时间
pos ------- 鼠标屏幕坐标
|;
(cond ((= msg WM_KEYUP) ;按键抬起
)
((= msg WM_KEYDOWN) ;键按下
(setq txt (chr wparam))
)
((= msg WM_SYSKEYDOWN)) ;系统键按下
((= msg WM_CHAR)
)
((= msg WM_MOUSEWHEEL) ;拨动滚轮
)
((= msg WM_LBUTTONUP) ;鼠标左键弹起
)
((= msg WM_LBUTTONDOWN) ;鼠标左键按下
)
((= msg WM_LBUTTONDBLCLK) ;鼠标左键双击
)
((= msg WM_RBUTTONUP) ;鼠标右键弹起
)
((= msg WM_RBUTTONDOWN) ;鼠标右键按下
)
((= msg WM_RBUTTONDBLCLK) ;鼠标右键双击
)
((= msg WM_MBUTTONUP) ;鼠标中键弹起
)
((= msg WM_MBUTTONDOWN) ;鼠标中键按下
)
((= msg WM_MBUTTONDBLCLK) ;鼠标中键双击
)
((= msg WM_MOUSEMOVE) ;鼠标移动
)
((= msg WM_PAINT) ;屏幕绘制
)
((= msg WM_HOTKEY) ;热键
)
((= msg WM_INPUT) ;输入
)
((= msg WM_VSCROLL) ;屏幕滚动
)
)
)

(defun hook (hwnd msg wparam lparam time pos) 
;| 
hwnd -- 窗口句柄 
msg --- 消息 
wparam -- 主参数 
lparam ---- 第二参数 
time ------- 发生时间 
pos  ------- 鼠标屏幕坐标 
|; 
 
  (cond        ((= msg WM_KEYUP)                ;按键抬起 
        ) 
        ((= msg WM_KEYDOWN)                ;键按下 
         (setq txt (chr wparam)) 
        ) 
        ((= msg WM_SYSKEYDOWN))                ;系统键按下 
        ((= msg WM_CHAR) 
        ) 
        ((= msg WM_MOUSEWHEEL)                ;拨动滚轮 
        ) 
        ((= msg WM_LBUTTONUP)                ;鼠标左键弹起 
        ) 
        ((= msg WM_LBUTTONDOWN)                ;鼠标左键按下 
        ) 
        ((= msg WM_LBUTTONDBLCLK)        ;鼠标左键双击 
        ) 
        ((= msg WM_RBUTTONUP)                ;鼠标右键弹起 
        ) 
        ((= msg WM_RBUTTONDOWN)                ;鼠标右键按下 
        ) 
        ((= msg WM_RBUTTONDBLCLK)        ;鼠标右键双击 
        ) 
        ((= msg WM_MBUTTONUP)                ;鼠标中键弹起 
        ) 
        ((= msg WM_MBUTTONDOWN)                ;鼠标中键按下 
        ) 
        ((= msg WM_MBUTTONDBLCLK)        ;鼠标中键双击 
        ) 
        ((= msg WM_MOUSEMOVE)                ;鼠标移动 
        ) 
        ((= msg WM_PAINT)                ;屏幕绘制 
        ) 
        ((= msg WM_HOTKEY)                ;热键 
        ) 
        ((= msg WM_INPUT)                ;输入 
        ) 
        ((= msg WM_VSCROLL)                ;屏幕滚动 
        ) 
  ) 
)

下面通过一个ODCL的捕获鼠标热键的程序说明：
下面程序会把键盘的按键，包括CTRL,SHIFT,ALT和字母键的组合，实时写到文本框里面。

(defun c:tt ()
(setq odcl-data
'("YWt6A2YXAAAh3q+ZBuKTJsUwKi9qI/1OYh86Xl9frzx8ON3ysnVmUlK6Jtb29vdoaHSydoxmezrS"
"zu26uLTmFh8Xn02Pa1XdcwgC/mE+nNVNeOsP4U0OYRVmUFYev6KaoEeVQohAGZHLqZss4OA1hb32"
"XvRmZK96v4RQkzt03ZY5fKlu6ghxxE9+Yf6XHN46AIvKxNonZOif+jIW6Ndfursu3cocrGlo7T+X"
"97byUBdLdXA3AXEk3qO42tk1KGTJFxNPUIOZ20EUKInmSx8nrRtSWBtSX9NoZxFIgOwcQxgusqYS"
"5KHzYX/DJU/keNTfAla+glsQ9HC15/hPVu2ralRpOJjZ1u1W+p0sbZiamORv/ZTg5rEiQE8orfOD"
"JkIec85jq9xjPRbrbXK3Jjw4JZswHzqklMm1nIjBy9a4IgjI07Lwy+U0hcJBiodBxNI8I1uCtOAR"
"nIv8jjW8sXeBWgWd+oNASYAbmTllLEkuElspmdlIGcyh37bPbjTvm3HQ6y7Fk+PA6EXON2Alc9IZ"
"MOvg7K7zNdZxnPRCObuXLnAAaz4nGRHJQyoVkglnU77Tp3ArOsVyxpwty+6b6hpH9rWcwDGipSeT"
"7fKJ5dQtMfensXZB37ZBWIL2jj28W+rnX6kXfBOWunDHBXMledoDNuBp3lAklUwHN29gytyahdBN"
"ojGdffpHsetqm6XKsVQFQtqPd2UxFALtsKc/jZkSgbigKaSxaVVw54vh9hmhko3nh+FTOBkOY9Oh"
"F4XhrJ25F0E517zwbxBdAvpOApCGxpUcDUilqlD01t0MsLZjro9VTY5+KfDMVVlbwU8ab+AXucpS"
"XbKXGQROA+YgMkHYGWmH5VoC5A78Tq2XUJ/NUCLfdQIyGgCmbJUw96bW744QN742SL/Cdpc7Tlga"
"7AiW3xRzuvhuH7llCyh5wq40Jhii3/StZFHfJRhAlTD7E7GyIdBww8+DAK+F9O0hUWOnNZnW3Idw"
"I8fRD0OrI+6OYMyB4IitP4gVNimIR6CabbaoY/nw6r3TXU0me2MX34PEC9oO/6o11/moId1gJXKK"
"LPEWIEMM1DkSndf5AImaqx2Tq72C65ou8TUmUYv2UzFDfHgE1zla0WBHq13Ej6qdRIyUH6clPYtG"
"eckEor8E1zkKB5QvFN7pBAYBk9FcSWEWshybuytoVdGRhauciBQBoQWrtDTBgccIJionCicagcuo"
"JuonysMU7zviFU3Z1jkM98QpS4G5gQa6nyj1ySaaW89QlG+PKnEDg39nvMRW")
)
(defun c:hook-quit#OnClicked (/)
(xd::hook:remove "_hook-1")
(dcl-form-close hotkey-odcl/Form1)
(princ)
)
(defun c:hotkey-odcl/Form1#OnClose (UpperLeftX UpperLeftY /)
(xd::hook:remove "_hook-1")
(dcl-form-close hotkey-odcl/Form1)
(princ)
)
(defun c:hotkey-odcl/Form1#OnCancelClose (Reason /)
(xd::hook:remove "_hook-1")
(dcl-form-close hotkey-odcl/Form1)
(princ)
)
(defun c:hotkey-odcl/Form1#OnCancel (/)
(xd::hook:remove "_hook-1")
(dcl-form-close hotkey-odcl/Form1)
(princ)
)
(defun c:var1#OnSetFocus (/)
(setq #var-name (dcl-Control-GetProperty var1 "VarName"))
)
(defun c:var2#OnSetFocus (/)
(setq #var-name (dcl-Control-GetProperty var2 "VarName"))
)
(defun c:var3#OnSetFocus (/)
(setq #var-name (dcl-Control-GetProperty var3 "VarName"))
)
(defun c:var4#OnSetFocus (/)
(setq #var-name (dcl-Control-GetProperty var4 "VarName"))
)
(defun _hook-1 (hwnd msg wparam lparam time pos)
(and (dcl-Form-IsActive hotkey-odcl/Form1)
(cond ((= msg WM_KEYDOWN)
(if (and (> wparam 46)
(< wparam 91)
(/= "" #var-name)
)
(progn
(setq txt (chr wparam))
(cond
((xdrx-system-ctrl-down)
(dcl-Control-SetText
(eval (read #var-name))
(strcat "CTRL+" txt)
)
)
((xdrx-system-shift-down)
(dcl-Control-SetText
(eval (read #var-name))
(strcat "SHIFT+" txt)
)
)
((xdrx-system-ctrl-shift-down)
(dcl-Control-SetText
(eval (read #var-name))
(strcat "CTRL+SHIFT+" txt)
)
)
((xdrx-system-ctrl-alt-shift-down)
(dcl-Control-SetText
(eval (read #var-name))
(strcat "CTRL+ALT+SHIFT+" txt)
)
)
)
(xdrx-hook-block-messageloop t) ;;阻断该消息让AUTOCAD继续处理。
)
)
)
(T)
)
)
)
(setq #var-name "")
(xd::hook:register "_hook-1" t "dd")
(dcl-project-import odcl-data "123456")
(dcl-Form-Show hotkey-odcl/Form1)
(princ)
)

(defun c:tt () 
  (setq        odcl-data 
         '("YWt6A2YXAAAh3q+ZBuKTJsUwKi9qI/1OYh86Xl9frzx8ON3ysnVmUlK6Jtb29vdoaHSydoxmezrS" 
"zu26uLTmFh8Xn02Pa1XdcwgC/mE+nNVNeOsP4U0OYRVmUFYev6KaoEeVQohAGZHLqZss4OA1hb32" 
"XvRmZK96v4RQkzt03ZY5fKlu6ghxxE9+Yf6XHN46AIvKxNonZOif+jIW6Ndfursu3cocrGlo7T+X" 
"97byUBdLdXA3AXEk3qO42tk1KGTJFxNPUIOZ20EUKInmSx8nrRtSWBtSX9NoZxFIgOwcQxgusqYS" 
"5KHzYX/DJU/keNTfAla+glsQ9HC15/hPVu2ralRpOJjZ1u1W+p0sbZiamORv/ZTg5rEiQE8orfOD" 
"JkIec85jq9xjPRbrbXK3Jjw4JZswHzqklMm1nIjBy9a4IgjI07Lwy+U0hcJBiodBxNI8I1uCtOAR" 
"nIv8jjW8sXeBWgWd+oNASYAbmTllLEkuElspmdlIGcyh37bPbjTvm3HQ6y7Fk+PA6EXON2Alc9IZ" 
"MOvg7K7zNdZxnPRCObuXLnAAaz4nGRHJQyoVkglnU77Tp3ArOsVyxpwty+6b6hpH9rWcwDGipSeT" 
"7fKJ5dQtMfensXZB37ZBWIL2jj28W+rnX6kXfBOWunDHBXMledoDNuBp3lAklUwHN29gytyahdBN" 
"ojGdffpHsetqm6XKsVQFQtqPd2UxFALtsKc/jZkSgbigKaSxaVVw54vh9hmhko3nh+FTOBkOY9Oh" 
"F4XhrJ25F0E517zwbxBdAvpOApCGxpUcDUilqlD01t0MsLZjro9VTY5+KfDMVVlbwU8ab+AXucpS" 
"XbKXGQROA+YgMkHYGWmH5VoC5A78Tq2XUJ/NUCLfdQIyGgCmbJUw96bW744QN742SL/Cdpc7Tlga" 
"7AiW3xRzuvhuH7llCyh5wq40Jhii3/StZFHfJRhAlTD7E7GyIdBww8+DAK+F9O0hUWOnNZnW3Idw" 
"I8fRD0OrI+6OYMyB4IitP4gVNimIR6CabbaoY/nw6r3TXU0me2MX34PEC9oO/6o11/moId1gJXKK" 
"LPEWIEMM1DkSndf5AImaqx2Tq72C65ou8TUmUYv2UzFDfHgE1zla0WBHq13Ej6qdRIyUH6clPYtG" 
"eckEor8E1zkKB5QvFN7pBAYBk9FcSWEWshybuytoVdGRhauciBQBoQWrtDTBgccIJionCicagcuo" 
"JuonysMU7zviFU3Z1jkM98QpS4G5gQa6nyj1ySaaW89QlG+PKnEDg39nvMRW") 
  ) 
  (defun c:hook-quit#OnClicked (/) 
    (xd::hook:remove "_hook-1") 
    (dcl-form-close hotkey-odcl/Form1) 
    (princ) 
  ) 
  (defun c:hotkey-odcl/Form1#OnClose (UpperLeftX UpperLeftY /) 
    (xd::hook:remove "_hook-1") 
    (dcl-form-close hotkey-odcl/Form1) 
    (princ) 
  ) 
  (defun c:hotkey-odcl/Form1#OnCancelClose (Reason /) 
    (xd::hook:remove "_hook-1") 
    (dcl-form-close hotkey-odcl/Form1) 
    (princ) 
  ) 
  (defun c:hotkey-odcl/Form1#OnCancel (/) 
    (xd::hook:remove "_hook-1") 
    (dcl-form-close hotkey-odcl/Form1) 
    (princ) 
  ) 
 
  (defun c:var1#OnSetFocus (/) 
    (setq #var-name (dcl-Control-GetProperty var1 "VarName")) 
  ) 
  (defun c:var2#OnSetFocus (/) 
    (setq #var-name (dcl-Control-GetProperty var2 "VarName")) 
  ) 
  (defun c:var3#OnSetFocus (/) 
    (setq #var-name (dcl-Control-GetProperty var3 "VarName")) 
  ) 
  (defun c:var4#OnSetFocus (/) 
    (setq #var-name (dcl-Control-GetProperty var4 "VarName")) 
  ) 
  (defun _hook-1 (hwnd msg wparam lparam time pos) 
    (and (dcl-Form-IsActive hotkey-odcl/Form1) 
         (cond ((= msg WM_KEYDOWN) 
                (if (and (> wparam 46) 
                         (< wparam 91) 
                         (/= "" #var-name) 
                    ) 
                  (progn 
                    (setq txt (chr wparam)) 
                    (cond 
                      ((xdrx-system-ctrl-down) 
                       (dcl-Control-SetText 
                         (eval (read #var-name)) 
                         (strcat "CTRL+" txt) 
                       ) 
                      ) 
                      ((xdrx-system-shift-down) 
                       (dcl-Control-SetText 
                         (eval (read #var-name)) 
                         (strcat "SHIFT+" txt) 
                       ) 
                      ) 
                      ((xdrx-system-ctrl-shift-down) 
                       (dcl-Control-SetText 
                         (eval (read #var-name)) 
                         (strcat "CTRL+SHIFT+" txt) 
                       ) 
                      ) 
                      ((xdrx-system-ctrl-alt-shift-down) 
                       (dcl-Control-SetText 
                         (eval (read #var-name)) 
                         (strcat "CTRL+ALT+SHIFT+" txt) 
                       ) 
                      ) 
                    ) 
                    (xdrx-hook-block-messageloop t) ;;阻断该消息让AUTOCAD继续处理。 
                  ) 
                ) 
               ) 
               (T) 
         ) 
    ) 
  ) 
  (setq #var-name "") 
  (xd::hook:register "_hook-1" t "dd") 
  (dcl-project-import odcl-data "123456") 
  (dcl-Form-Show hotkey-odcl/Form1) 
  (princ) 
)

liuyj · 发表于 2018-1-8 16:09:52

早就希望有这个功能了，这样可以对按下的键进行捕获

liunian0524 · 发表于 2018-1-9 08:08:09

感谢楼主分享

xyz002 · 发表于 2018-6-20 12:15:28

非常好，辛苦了

jinjieqin111 · 发表于 2021-1-11 11:36:07

多谢分享

lizhaojun45 · 发表于 2022-5-27 19:24:06

(defun hook (hwnd msg wparam lparam time pos)
hwnd -- 窗口句柄
msg --- 消息，
大佬msg这个传入参数，怎么获取到

pxt2015 · 发表于 2022-12-17 15:54:18

本帖最后由 pxt2015 于 2022-12-17 15:57 编辑

钩子应用例子，光ctrl,alt.shift组合有啥意思，以下截图为网友arx开发的“单键快捷”工具，
可以设置键盘的箭头按键，F1-F12功能键，PageDown按键，也就是将键盘按键一网打尽。
版主能否给一个示例
单键快捷.png

账号		自动登录	找回密码
密码			立即注册

[教学] 让LISP控制WINDOWS消息循环（给ACAD注入钩子）监控键盘鼠标消息

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。