قد يجعلك ذلك تشعر بالدوار، ولكن طالما أنك تعرف معرفة لغة VB وتريد هذا الشيء، فعليك أن تدرسه بعناية.
modHook.bas
الخيار صريح
الإعلان العام عن وظيفة CallNextHookEx Lib user32.dll (ByVal hHook As Long، ByVal nCode As Long، ByVal wParam As Long، lparam As Any) طالما
الإعلان العام عن Sub CopyMemory Lib kernel32 الاسم المستعار RtlMoveMemory (lpDest As Any، lpSource As Any، ByVal cBytes As Long)
الإعلان العام عن المفتاح الفرعي keybd_event Lib user32 (ByVal bVk As Byte، ByVal bScan As Byte، ByVal dwFlags As Long، ByVal dwExtraInfo As Long)
البيانات العامة () كسلسلة
NUM عام طويل
OldHook العام طالما
LngClsPtr العامة طالما
الخطاف الخلفي للوظيفة العامة (ByVal nCode طويل، ByVal wParam طويل، ByVal lparam طويل)
إذا كان nCode <0 ثم
BackHook = CallNextHookEx(OldHook, nCode, wParam, lparam)
وظيفة الخروج
نهاية إذا
ResolvePointer(LngClsPtr).RiseEvent (lparam)
استدعاء CallNextHookEx(OldHook، nCode، wParam، lparam)
وظيفة النهاية
الوظيفة الخاصة ResolvePointer (ByVal lpObj As Long) مثل ClsHook
خافت OSH كما ClsHook
CopyMemory OSH، lpObj، 4&
قم بتعيين ResolvePointer = oSH
ذاكرة النسخ OSH، 0&، 4&
وظيفة النهاية
ClsHook.cls
الخيار صريح
حدث عام KeyDown (رمز المفتاح كعدد صحيح، Shift كعدد صحيح)
نوع خاص EVENTMSG
wMsg طالما
lParamLow طالما
lParamHigh طالما
msgTime طالما
hWndMsg طالما
نوع النهاية
الكونست الخاص WH_JOURNALRECORD = 0
الكونست الخاص WM_KEYDOWN = &H100
إعلان خاص وظيفة SetWindowsHookEx Lib user32.dll الاسم المستعار SetWindowsHookExA (ByVal idHook طويل، ByVal lpfn طويل، ByVal hmod طويل، ByVal dwThreadId طويل)
إعلان خاص عن وظيفة UnhookWindowsHookEx Lib user32.dll (ByVal hHook As Long) طالما
إعلان خاص عن وظيفة GetAsyncKeyState Lib user32.dll (ByVal vKey As Long) كعدد صحيح
مجموعة فرعية عامة ()
OldHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf BackHook, App.hInstance, 0)
نهاية الفرعية
UnHook الفرعي العام ()
استدعاء UnhookWindowsHookEx(OldHook)
نهاية الفرعية
وظيفة الصديق RiseEvent (ByVal lparam As Long) طويلة
تعتيم الرسالة كـ EVENTMSG
تعتيم IntShift كعدد صحيح
خافت IntCode كعدد صحيح
CopyMemory Msg، ByVal lparam، Len (Msg)
إنت شيفت = 0
حدد حالة Msg.wMsg
الحالة WM_KEYDOWN
إذا كان GetAsyncKeyState(vbKeyShift) ثم IntShift = (IntShift أو 1)
إذا كان GetAsyncKeyState(vbKeyControl) ثم IntShift = (IntShift Or 2)
إذا كان GetAsyncKeyState(vbKeyMenu) ثم IntShift = (IntShift أو 4)
IntCode = Msg.lParamLow و&HFF
Debug.Print Msg.lParamLow
تصحيح الأخطاء وطباعة HFF
RaiseEvent KeyDown (IntCode، IntShift)
إنهاء التحديد
وظيفة النهاية
فئة فرعية خاصة_Initialize()
LngClsPtr = ObjPtr(Me)
نهاية الفرعية
form1.frm
الخيار صريح
ربط خافت مع الأحداث باسم ClsHook
إعلان خاص عن وظيفة MapVirtualKeyEx Lib user32 الاسم المستعار MapVirtualKeyExA (ByVal uCode طويل، ByVal uMapType طويل، ByVal dwhkl طويل)
إعلان خاص عن وظيفة GetKeyboardLayout Lib user32 (ByVal dwLayout As Long) طالما
إعلان خاص عن وظيفة GetForegroundWindow Lib user32 () طالما
إعلان خاص عن وظيفة GetWindowThreadProcessId Lib user32 (ByVal hwnd As Long، lpdwProcessId As Long) طالما
الخاص الفرعي Hook_KeyDown (رمز المفتاح كعدد صحيح، Shift كعدد صحيح)
خافت StrCode كسلسلة
StrCode = CodeToString(KeyCode)
إذا كان StrCode = [Shift] أو StrCode = [Alt] أو StrCode = [Ctrl] إذن
إذا كان Shift = vbAltMask + vbCtrlMask ثم StrCode = [Alt + Ctrl]
إذا كان Shift = vbAltMask + vbShiftMask ثم StrCode = [Alt + Shift]
إذا كان Shift = vbCtrlMask + vbShiftMask ثم StrCode = [Ctrl + Shift]
إذا كان Shift = vbCtrlMask + vbShiftMask + vbAltMask ثم StrCode = [Ctrl + Shift +Alt]
آخر
إذا كان Shift = vbShiftMask ثم StrCode = [Shift] + & StrCode
إذا كان Shift = vbCtrlMask ثم StrCode = [Ctrl] + & StrCode
إذا كان Shift = vbAltMask ثم StrCode = [Alt] + & StrCode
إذا Shift = vbAltMask + vbCtrlMask ثم StrCode = [Alt + Ctrl] + & StrCode
إذا كان Shift = vbAltMask + vbShiftMask ثم StrCode = [Alt + Shift] + & StrCode
إذا Shift = vbCtrlMask + vbShiftMask ثم StrCode = [Ctrl + Shift] + & StrCode
إذا Shift = vbCtrlMask + vbShiftMask + vbAltMask ثم StrCode = [Ctrl + Shift +Alt] + & StrCode
نهاية إذا
إذا كان LCase(StrCode) = LCase(HotKey) فإن هذا القسم عبارة عن وظيفة بسيطة بعد ربط لوحة المفاتيح، وهي إخفاء النافذة من وعرضها.
إذا كان App.TaskVisible = خطأ، إذن
أنا.عرض
App.TaskVisible = صحيح
آخر
أنا.إخفاء
App.TaskVisible = خطأ
نهاية إذا
نهاية إذا
نهاية الفرعية
وظيفة خاصة CodeToString(nCode كعدد صحيح) كسلسلة
خافت StrKey كسلسلة
حدد رمز الحالة
حالة vbKeyBack: StrKey = BackSpace
حالة vbKeyTab: StrKey = Tab
الحالة vbKeyClear: StrKey = Clear
الحالة vbKeyReturn: StrKey = Enter
حالة vbKeyShift: StrKey = Shift
حالة vbKeyControl: StrKey = Ctrl
حالة vbKeyMenu: StrKey = Alt
الحالة vbKeyPause: StrKey = Pause
حالة vbKeyCapital: StrKey = CapsLock
حالة vbKeyEscape: StrKey = ESC
الحالة vbKeySpace: StrKey = SPACEBAR
الحالة vbKeyPageUp: StrKey = PAGE UP
الحالة vbKeyPageDown: StrKey = PAGE DOWN
حالة vbKeyEnd: StrKey = END
الحالة vbKeyHome: StrKey = HOME
الحالة vbKeyLeft: StrKey = السهم لليسار
حالة vbKeyUp: StrKey = سهم لأعلى
الحالة vbKeyRight: StrKey = السهم لليمين
الحالة vbKeyDown: StrKey = السهم لأسفل
حالة vbKeySelect: StrKey = SELECT
الحالة vbKeyPrint: StrKey = PRINT SCREEN
الحالة vbKeyExecute: StrKey = EXECUTE
حالة vbKeySnapshot: StrKey = SNAPSHOT
حالة vbKeyInsert: StrKey = INS
حالة vbKeyDelete: StrKey = DEL
الحالة vbKeyHelp: StrKey = HELP
حالة vbKeyNumlock: StrKey = NUM LOCK
الحالة vbKey0 إلى vbKey9: StrKey = Chr$(nCode)
حالة vbKeyA إلى vbKeyZ: StrKey = LCase(Chr$(nCode)) 'MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
حالة vbKeyF1 إلى vbKeyF16: StrKey = F & CStr(nCode - 111)
حالة vbKeyNumpad0 إلى vbKeyNumpad9: StrKey = Numpad & CStr(nCode - 96)
الحالة vbKeyMultiply: StrKey = Numpad {*}
حالة vbKeyAdd: StrKey = Numpad {+}
حالة vbKeySeparator: StrKey = Numpad {ENTER}
الحالة vbKeySubtract: StrKey = Numpad {-}
الحالة vbKeyDecimal: StrKey = Numpad {.}
الحالة vbKeyDivide: StrKey = Numpad {/}
حالة أخرى
StrKey = Chr$(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0)))) & Str(MapVirtualKeyEx(nCode, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0))))
إنهاء التحديد
CodeToString = [&StrKey &]
وظيفة النهاية