;H20000 Const STANDARD_RIGHTS_READ = (READ_CONTROL) Const KEY_QUERY_VALUE = &H1 Const KEY_ENUMERATE_SUB_KEYS = &H8 Const KEY_NOTIFY = &H10 Const SYNCHRONIZE = &H100000 Const KEY_READ = ((STANDARD_RIGHTS_READ Or _ KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or _ KEY_NOTIFY) And (Not SYNCHRONIZE))
Dim key5 As String, ValueName as String, strBuff as String, ResultStr as String Dim leng1 As Long, resul As Long, hkey As Long Dim tp As Long, i As Long
我们知道Win API 的阵列传递是传阵列的起始位址，所以了，在VB中唯一要注意的 是起始位置的写法。以另一个取得Window目录所在路径的API为 例： ----------------------------------------------------------------------------- UINT GetWindowsDirectory( LPTSTR lpBuffer, // address of buffer for Windows directory UINT uSize // size of directory buffer ); // 若成功，则传回目录的字元数 VB的宣告(API检视员) Declare Function GetWindowsDirectory Lib "kernel32" Alias _ "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) _ As Long 我们将之更改为 Declare Function GetWindowsDirectory Lib "kernel32" Alias _ "GetWindowsDirectoryA" ( lpBuffer As Byte, ByVal nSize As Long) As Long
----------------------------------------------------------------------------- 范例四 ***************************************************************************** Dim n as Long Dim Buff() as Byte Dim StrA as String
----------------------------------------------------------------------------- HHOOK SetWindowsHookEx( int idHook, // type of hook to install HOOKPROC hkprc, // address of hook procedure HINSTANCE hMod, // handle of application instance DWORD dwThreadID // identity of thread to install hook for );
Declare Function SetWindowsHookEx Lib "user32" Alias SetWindowsHookExA" _ (ByVal idHook As Long, _ ByVal lpfn As Long, _ ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long
以上面的例子来说，这个CallBack Function定义如下： ----------------------------------------------------------------------------- Public Function MyKBHFunc(ByVal iCode As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long MyKBHFunc = 0 If iCode < 0 Then MyKBHFunc = CallNextHookEx(hnexthookproc, iCode, wParam, lParam) Exit Function End If ''''侦测 有没有按到PrintScreen键 If wParam = vbKeySnapshot Then MyKBHFunc = 1 Debug.Print "haha" End If End Function -----------------------------------------------------------------------------
范例五 ***************************************************************************** ''''以下程式於Hook.bas Declare Function SetWindowsHookEx Lib "user32" Alias _ "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _ ByVal hmod As Long, ByVal dwThreadId As Long) As Long Declare Function UnhookWindowsHookEx Lib "user32" _ (ByVal hHook As Long) As Long Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public hnexthookproc As Long Public Const HC_ACTION = 0 Public Const WH_KEYBOARD = 2
Public Sub UnHookKBD() If hnexthookproc 0 Then UnhookWindowsHookEx hnexthookproc hnexthookproc = 0 End If End Sub Public Function EnableKBDHook() If hnexthookproc 0 Then Exit Function End If hnexthookproc = SetWindowsHookEx(WH_KEYBOARD, AddressOf _ MyKBHFunc, App.Hinstance, 0) If hnexthookproc 0 Then EnableKBDHook = hnexthookproc End If End Function Public Function MyKBHFunc(ByVal iCode As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long ''''这三个参数是固定的，不能动，而MyKBHFunc这个名称只要和 ''''SetWindowsHookex()中 AddressOf後的名称一样便可，不一定叫什麽 MyKBHFunc = 0 If iCode < 0 Then MyKBHFunc = CallNextHookEx(hnexthookproc, iCode, wParam, lParam) Exit Function End If If wParam = vbKeySnapshot Then ''''侦测 有没有按到PrintScreen键 MyKBHFunc = 1 Debug.Print "haha" End If End Function ''''以下程式於Form Private Sub Form_Load() Call EnableKBDHook End Sub
Private Sub Form_Unload(Cancel As Integer) Call UnHookKBD End Sub ***************************************************************************** 七、自订型态的传递
----------------------------------------------------------------------------- Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" ( _ lpvDest As Any, lpvSource As Any, ByVal cbCopy as Long) -----------------------------------------------------------------------------
----------------------------------------------------------------------------- Dim dbl as Double Dim bte(0 to 7) as Byte Dbl = 168.256 CopyMemory dbl, byt(0), 8 -----------------------------------------------------------------------------
范例六 ***************************************************************************** '''' 以下在Hook.bas Const WM_MOUSELAST = &H209 Const WM_MOUSEFIRST = &H200 Public Const WM_KEYLAST = &H108 Public Const WM_KEYFIRST = &H100 Public Const WH_JOURNALRECORD = 0 Type EVENTMSG message As Long paramL As Long paramH As Long time As Long hwnd As Long End Type Declare Function SetWindowsHookEx Lib "user32" Alias _ "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _ ByVal hmod As Long, ByVal dwThreadId As Long) As Long Declare Function UnhookWindowsHookEx Lib "user32" _ (ByVal hHook As Long) As Long Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" _ (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long) Public hNxtHook As Long '''' handle of Hook Procedure Public msg As EVENTMSG
Sub EnableHook() hNxtHook = SetWindowsHookEx(0, AddressOf HookProc, App.hInstance, 0) End Sub Sub FreeHook() Dim ret As Long ret = UnhookWindowsHookEx(hNxtHook) End Sub Function HookProc(ByVal code As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long CopyMemory msg, lParam, Lenb(msg) If (msg.message >= WM_KEYFIRST _ And msg.message <= WM_KEYLAST) Then Debug.Print msg.message, msg.paramH End If HookProc = CallNextHookEx(hNxtHook, code, wParam, lParam) End Function ''''以下程式於Form1 Private Sub Form_Load() Call EnableHook End Sub
Private Sub Form_Unload(Cancel As Integer) Call FreeHook End Sub *****************************************************************************
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
