システムフックで使用したＤＬＬを開放するには？ (ID:53351)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

メモ帳の監視を行うサンプルです。

'--------------------------------------------------
ＶＢのフォーム
'--------------------------------------------------
Private Sub Form_Load()

'多重チェック（多重すると悲惨です）
If App.PrevInstance = True Then
MsgBox "多重起動です。", MB_TOPMOST, "error"
Unload Form1
Exit Sub
End If

Call g_SetHook(Form1.hWnd) '自分自身フック開始
Call SetHook(Form1.hWnd)   'グローバルフック開始

End Sub
Private Sub Form_Unload(Cancel As Integer)

Call g_UnHook '自分自身フック終了
Call FreeHook 'グローバルフック終了

End Sub
'--------------------------------------------------
ＶＢのモジュール
'--------------------------------------------------
Option Explicit
'--------------------------------------------------
'自作ＤＬＬ使用
'--------------------------------------------------
Public Declare Function SetHook Lib "hook_test.dll" (ByVal hWnd As Long) As Long
Public Declare Function FreeHook Lib "hook_test.dll" () As Long

'--------------------------------------------------
'自分自身フック用
'--------------------------------------------------
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long)

Public Const WM_COPYDATA = &H4A
Public Const GWL_WNDPROC = (-4)

Public Type COPYDATASTRUCT
lng_dwData As Long '謎
lng_cbData As Long '文字列の長さ
lng_lpData As Long '文字列
End Type

Private m_lng_WH As Long
Private m_lng_Hook As Long
Public Sub g_SetHook(ByVal lng_WH As Long)

'フック開始
m_lng_Hook = SetWindowLong(lng_WH, GWL_WNDPROC, AddressOf g_HookProcedure)
m_lng_WH = lng_WH
    
End Sub
Public Sub g_UnHook()

'フック解除
If m_lng_Hook <> 0 Then
Call SetWindowLong(m_lng_WH, GWL_WNDPROC, m_lng_Hook)
End If

m_lng_Hook = 0

End Sub
Public Function g_HookProcedure( _
ByVal lng_WH As Long, _
ByVal lng_Message As Long, _
ByVal lng_WParameter As Long, _
ByVal lng_LParameter As Long) As Long

If lng_Message = WM_COPYDATA Then
Dim str_Data As String
Dim udt_CDS  As COPYDATASTRUCT

Call CopyMemory(udt_CDS, ByVal lng_LParameter, Len(udt_CDS))
str_Data = String(udt_CDS.lng_cbData, 0)
Call CopyMemory(ByVal str_Data, ByVal udt_CDS.lng_lpData, udt_CDS.lng_cbData)
str_Data = Left(str_Data, InStr(str_Data, vbNullChar) - 1)
    
Debug.Print "受信！"; str_Data
End If

g_HookProcedure = _
CallWindowProc(m_lng_Hook, lng_WH, lng_Message, lng_WParameter, lng_LParameter)

End Function

長くなるのでＤＬＬと分けて書きます。

←解決時は質問者本人がここをチェックしてください。

戻る