ab.com コミュニティ

コード: 全て選択

Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As HWND
    wHitTestCode As DWord
    dwExtraInfo As DWord
End Type

Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (idHook As DWord, lpfn As DWord,hMod As DWord, dwThreadId As DWord) As DWord
Declare Function UnhookWindowsHookEx Lib "user32" (hHook As DWord) As DWord 
Declare Function CallNextHookEx Lib "user32" (hHook As DWord, nCode As Long, wParam As DWord, lParam As DWord) As DWord

Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (hFile As HANDLE, ByRef lpFileMappingAttributes As SECURITY_ATTRIBUTES, flProtect As DWord, dwMaximumSizeHigh As DWord, dwMaximumSizeLow As DWord, lpName As BytePtr) As HANDLE
Declare Function MapViewOfFile Lib "kernel32" (hFileMappingObject As HANDLE, dwDesiredAccess As DWord, dwFileOffsetHigh As DWord, dwFileOffsetLow As DWord, dwNumberOfBytesToMap As DWord) As VoidPtr
Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As VoidPtr) As Long

Dim hMF As HANDLE
Dim pData As *DWord
Dim hInst As DWord

Const WM_MusKeyMOVE = (WM_USER+1)

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

            'メモリマップトファイルを作成
            hMF=CreateFileMapping(-1,ByVal NULL,PAGE_READWRITE,0,(4*8)*2,"Mouse Hook Test DLL")
            pData=MapViewOfFile(hMF,FILE_MAP_ALL_ACCESS,0,0,0)
        Case DLL_PROCESS_DETACH
            'DLLがプロセス空間から解除された時に実行されます。
            'メモリマップトファイルを破棄
            UnmapViewOfFile(pData)
            CloseHandle(hMF)
    End Select
 End Function

Function Export StartHook(hWnd As DWord) As Long
    'Hookのインストール
    pData[0]=SetWindowsHookEx(WH_MOUSE, AddressOf(GetMouseMsgProc), hInst, 0)
    pData[1]=hWnd
    If pData[0]=0 Then StartHook=-1
End Function
 
 
Function Export EndHook() As Long
    'Hookのアンインストール
    If pData[0] Then UnhookWindowsHookEx(pData[0]) Else EndHook=-1
End Function

Function GetMouseMsgProc(code As Long, wParam As DWord, lParam As DWord) As DWord
    Dim pmh As *MOUSEHOOKSTRUCT
    'Dim c        As Long
    pmh=lParam
    If code<0 Then
        GetMouseMsgProc=CallNextHookEx(pData[0],code,wParam,lParam)
        Exit Function
    End If
    Select Case wParam
        Case WM_LBUTTONDOWN
            Dim buf[255] As Byte
            wsprintf(buf,"x:%d y:%d hwnd:%d",pmh->pt.x,pmh->pt.y,pmh->hwnd)
            SetWindowText(pData[1],buf)
            PostMessage(pData[1],WM_MusKeyMOVE,0,0)
            Exit Function
    End Select
    '次のフックを呼び出す
    GetMouseMsgProc = CallNextHookEx(pData[0],code,wParam,lParam)
End Function

コード: 全て選択

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。

	Declare Function StartHook Lib "GetStatusMK" (hWnd As DWord) As Long

	Declare Function EndHook Lib "GetStatusMK" () As Long


	Const WM_MusKeyMOVE	= (WM_APP+1)'システムフック用(GetStatusMK.dll)メッセージコード

'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As DWord, dwMsg As DWord, wParam As DWord, lParam As DWord) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
	Select Case dwMsg
		Case WM_MusKeyMOVE
				Beep(5000,10)
	End Select

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
	'System Hookのアンインストール
	EndHook()
	TestHook_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	'System Hookのインストール
	If StartHook(hMainWnd)<0 Then
		SendMessage(hMainWnd,WM_CLOSE, 0, 0): ExitProcess(0)
	End If
End Sub

Sub MainWnd_CommandButton1_Click()
	SendMessage(hMainWnd,WM_CLOSE,0,0): ExitProcess(0)
End Sub

Sub MainWnd_QueryClose(ByRef cancel As Integer)
	Beep(8000,100)
End Sub

コード: 全て選択

Function GetMouseMsgProc(code As Long, wParam As DWord, lParam As DWord) As DWord
    Dim pmh As *MOUSEHOOKSTRUCT
    pmh=lParam
    If code<0 Then
        GetMouseMsgProc=CallNextHookEx(pData[0],code,wParam,lParam)
        Exit Function
    End If
    Select Case wParam
        Case WM_LBUTTONDOWN
            PostMessage(pData[1],WM_MusKeyMOVE,0,0)
    End Select
    '次のフックを呼び出す
    GetMouseMsgProc = CallNextHookEx(pData[0],code,wParam,lParam)
End Function