API调用,反复执行若干次,出现系统异常,好象内存泄漏了,请朋友们帮忙看看.

[mostone]

为了实现弹出对话框相对于活动窗口位置居中，写了一个Win32Hook.vb的文件，定义了一个Win32Hook的类，
在调用MessageBox.Show方法之前，执行Win32Hook.Hook方法来设置系统钩子，
并在回调函数中移动弹出对话框，使其相对于当前活动窗口居中。
但是在使用过程中，当反复弹出对话框N次后，在VS.Net的Debug环境下，系统抛出了一个空引用的错误，
具体的位置在MessageBox.Show这一行。

由于不熟悉API回调的使用，现在将相关代码附上，请朋友们帮忙看看，分析一下原因。



'******************************************************************************
'* 概要 ： 显示消息提示框
'* 参数 ： (i) strMessageID 消息ID
'* (i) objMsgButtons 消息框按钮
'* 返回值 ： 用户选择结果
'* 说明 ：
'******************************************************************************
Public Function ShowMessageBox(ByVal strMessage As String, _
ByVal objMsgIcon As MessageBoxIcon, _
Optional ByVal objMsgButtons As MessageBoxButtons = _
MessageBoxButtons.OK) As DialogResult
Dim intResult As DialogResult

' 设置使消息框居中的系统钩子
Win32Hook.Hook()

' 显示消息对话框
intResult = MessageBox.Show(strMessage, _
"System Message", _
objMsgButtons, _
objMsgIcon)

' 返回结果
Return intResult
End Function



//==========================================================

Option Strict On
Option Explicit On
'******************************************************************************
'* 文件名 ： Win32Hook.vb
'* 文件内容 ： 钩子调用，使消息框相对于系统窗口居中
'******************************************************************************

Public Class Win32Hook

#Region " 常量定义 "

' 钩子类型编号
Private Const intWH_CBT As Integer = 5
' 消息类型编号
Private Const intHCBT_ACTIVATE As Integer = 5

#End Region

#Region " 结构定义 "

' 矩形结构体
Private Structure RECT
' 左上角X坐标
Public intLeft As Integer
' 左上角Y坐标
Public intTop As Integer
' 右下角X坐标
Public intRight As Integer
' 右下角Y坐标
Public intBottom As Integer
End Structure

#End Region

#Region " 委托方法定义 "

' 钩子委托方法
Private Delegate Function HookProc(ByVal nCode As Integer, _
ByVal wParam As Integer, _
ByVal lParam As Integer) As Integer

#End Region

#Region " API方法定义 "

' 系统钩子挂载方法
Private Declare Function SetWindowsHookEx _
Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Integer, _
ByVal lpfn As HookProc, _
ByVal hmod As Integer, _
ByVal dwThreadId As Integer) As Integer

' 系统钩子卸载方法
Private Declare Function UnhookWindowsHookEx _
Lib "user32" (ByVal hHook As Integer) As Integer

' 按窗口句柄移动窗口方法
Private Declare Function MoveWindow _
Lib "user32" (ByVal hWnd As Integer, _
ByVal X As Integer, _
ByVal Y As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal bRepaint As Integer) As Integer

' 按窗口句柄取得窗口矩形
Private Declare Function GetWindowRect _
Lib "user32" (ByVal hWnd As Integer, _
ByRef lpRect As RECT) As Integer

#End Region

#Region " 变量定义 "

' 挂载的钩子编号
Private Shared intHook As Integer

#End Region

#Region " 静态方法 "

'******************************************************************************
'* 概要 ： 挂载系统钩子
'* 参数 ： 无
'* 返回值 ： 无
'* 说明 ： 无
'******************************************************************************
Public Shared Sub Hook()
'设置钩子
intHook = SetWindowsHookEx(intWH_CBT, _
AddressOf MessageProcess, _
0, _
AppDomain.GetCurrentThreadId)
End Sub

'******************************************************************************
'* 概要 ： 卸载系统钩子
'* 参数 ： 无
'* 返回值 ： 无
'* 说明 ： 无
'******************************************************************************
Public Shared Sub Unhook()
' 判断钩子是否存在
If intHook > 0 Then
'如果存在，卸载钩子
UnhookWindowsHookEx(intHook)
End If
End Sub

'******************************************************************************
'* 概要 ： CBT系统消息发生时的钩子处理
'* 参数 ： (i) nCode 消息类型
'* (i) wParam 消息参数
'* (i) lParam 消息参数
'* 返回值 ： 0
'* 说明 ： 无
'******************************************************************************
Private Shared Function MessageProcess(ByVal nCode As Integer, _
ByVal wParam As Integer, _
ByVal lParam As Integer) As Integer

'变量声明
Dim rcMessageBox As New RECT
Dim rcActiveForm As New RECT
Dim intActiveFormHandle As Integer
Dim intMessageBoxHandle As Integer
Dim intActiveFormWidth As Integer
Dim intActiveFormHeight As Integer
Dim intMessageBoxWidth As Integer
Dim intMessageBoxHeight As Integer
Dim intNewLeft As Integer
Dim intNewTop As Integer

' 判断是否是消息对话框引发的系统消息
If nCode <> intHCBT_ACTIVATE Then
' 如果不是，返回
Return 0
End If

' 当消息对话框出现时，将消息对话框与所在的窗口居中
Try
' 判断当前有没有活动窗口
If Form.ActiveForm Is Nothing Then
' 返回结果
Return 0
End If
' 取得当前活动窗口的句柄
intActiveFormHandle = Form.ActiveForm.Handle.ToInt32
' 消息为HCBT_ACTIVATE时，参数wParam包含的是消息对话框的句柄
intMessageBoxHandle = wParam

' 取得消息对话框的矩形信息
Call GetWindowRect(intMessageBoxHandle, rcMessageBox)
' 取得活动窗口的矩形信息
Call GetWindowRect(intActiveFormHandle, rcActiveForm)

' 计算消息对话框相对于活动窗口居中的新坐标
With rcActiveForm
intActiveFormWidth = .intRight - .intLeft
intActiveFormHeight = .intBottom - .intTop
End With
With rcMessageBox
intMessageBoxWidth = .intRight - .intLeft
intMessageBoxHeight = .intBottom - .intTop
End With
intNewLeft = rcActiveForm.intLeft + (intActiveFormWidth - intMessageBoxWidth) \ 2
intNewTop = rcActiveForm.intTop + (intActiveFormHeight - intMessageBoxHeight) \ 2

'Msgbox居中
Call MoveWindow(intMessageBoxHandle, _
intNewLeft, intNewTop, _
intMessageBoxWidth, intMessageBoxHeight, _
CType(True, Integer))

Catch ex As Exception
' 不处理异常
Finally
'卸载钩子
Unhook()
End Try

' 返回结果
Return 0

End Function

#End Region

End Class

[Tiger_Zhao]

对话框关闭后要调用 UnHook()

[晓轩]

友情帮顶.代码太长了.

[mostone]

flygoldfish(长江支流)
Tiger_Zhao(VB老鸟)
你们好:

我对代码作了修改，还是不行，弹了N次后出错。
出错时的Log记录：
[2006/06/23 13:10:36] 系统错误，请与管理员联系！System.NullReferenceException: 未将对象引用设置到对象的实例。
at System.Windows.Forms.UnsafeNativeMethods.IntDestroyWindow(HandleRef hWnd)
at System.Windows.Forms.UnsafeNativeMethods.DestroyWindow(HandleRef hWnd)
at System.Windows.Forms.NativeWindow.DestroyHandle()
at System.Windows.Forms.Control.DestroyHandle()
at System.Windows.Forms.Form.ShowDialog(IWin32Window owner)
at System.Windows.Forms.Form.ShowDialog()
at Main.BootForm.BootForm_Activated(Object sender, EventArgs e) in E:\BootForm.vb:line 106
at System.Windows.Forms.Form.OnActivated(EventArgs e)
at System.Windows.Forms.Form.set_Active(Boolean value)
at System.Windows.Forms.Form.WmActivate(Message& m)
at System.Windows.Forms.Form.WndProc(Message& m)
at System.Windows.Forms.ControlNativeWindow.OnMessage(Message& m)
at System.Windows.Forms.ControlNativeWindow.WndProc(Message& m)
at System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)
[2006/06/23 13:10:36] 系统错误，请与管理员联系！System.NullReferenceException: 未将对象引用设置到对象的实例。
at System.Windows.Forms.UnsafeNativeMethods.SetForegroundWindow(HandleRef hWnd)
at System.Windows.Forms.Form.Activate()
at Main.BootForm.BootForm_Load(Object sender, EventArgs e) in E:\BootForm.vb:line 124
at System.Windows.Forms.Form.OnLoad(EventArgs e)
at System.Windows.Forms.Form.OnCreateControl()
at System.Windows.Forms.Control.CreateControl(Boolean fIgnoreVisible)
at System.Windows.Forms.Control.CreateControl()
at System.Windows.Forms.Control.WmShowWindow(Message& m)
at System.Windows.Forms.Control.WndProc(Message& m)
at System.Windows.Forms.ScrollableControl.WndProc(Message& m)
at System.Windows.Forms.ContainerControl.WndProc(Message& m)
at System.Windows.Forms.Form.WmShowWindow(Message& m)
at System.Windows.Forms.Form.WndProc(Message& m)
at System.Windows.Forms.ControlNativeWindow.OnMessage(Message& m)
at System.Windows.Forms.ControlNativeWindow.WndProc(Message& m)
at System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)

修改点：1、去除Shared，使用New一个实例后再使用
2、去除MessageProcess回调函数中的Unhook()调用
3、Unhook()方法中，追加对UnhookWindowsHookEx结果的判断

修改后的代码：

'******************************************************************************
'* 概要 ： 显示消息提示框
'* 参数 ： (i) strMessageID 消息ID
'* (i) objMsgButtons 消息框按钮
'* 返回值 ： 用户选择结果
'* 说明 ：
'* 作成日 ： 2006/05/12
'* 作成者 ：
'******************************************************************************
Public Shared Function ShowMessageBox(ByVal strMessage As String, _
ByVal objMsgIcon As MessageBoxIcon, _
Optional ByVal objMsgButtons As MessageBoxButtons = _
MessageBoxButtons.OK) As DialogResult
Dim intResult As DialogResult
Dim objHook As New Win32Hook

' 设置使消息框居中的系统钩子
objHook.Hook()

' 显示消息对话框
intResult = MessageBox.Show(strMessage, _
"CommonConst.strSYSTEM_NAME", _
objMsgButtons, _
objMsgIcon)

'卸载钩子
objHook.Unhook()

' 返回结果
Return intResult
End Function

[mostone]

//============================================================================
Option Strict On
Option Explicit On
'******************************************************************************
'* 系统名称 ：
'* 子系统名称 ：
'* 文件名 ： Win32Hook.vb
'* 文件内容 ： 钩子调用，使消息框相对于系统窗口居中
'* 作成日 ： 2006/06/22
'* 作成者 ：
'******************************************************************************

Public Class Win32Hook

#Region " 常量定义 "

' 钩子类型编号
Private Const intWH_CBT As Integer = 5
' 消息类型编号
Private Const intHCBT_ACTIVATE As Integer = 5

#End Region

#Region " 结构定义 "

' 矩形结构体
Private Structure RECT
' 左上角X坐标
Public intLeft As Integer
' 左上角Y坐标
Public intTop As Integer
' 右下角X坐标
Public intRight As Integer
' 右下角Y坐标
Public intBottom As Integer
End Structure

#End Region

#Region " 委托方法定义 "

' 钩子委托方法
Private Delegate Function HookProc(ByVal nCode As Integer, _
ByVal wParam As Integer, _
ByVal lParam As Integer) As Integer

#End Region

#Region " API方法定义 "

' 系统钩子挂载方法
Private Declare Function SetWindowsHookEx _
Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Integer, _
ByVal lpfn As HookProc, _
ByVal hmod As Integer, _
ByVal dwThreadId As Integer) As Integer

' 系统钩子卸载方法
Private Declare Function UnhookWindowsHookEx _
Lib "user32" (ByVal hHook As Integer) As Integer

' 按窗口句柄移动窗口方法
Private Declare Function MoveWindow _
Lib "user32" (ByVal hWnd As Integer, _
ByVal X As Integer, _
ByVal Y As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal bRepaint As Integer) As Integer

' 按窗口句柄取得窗口矩形
Private Declare Function GetWindowRect _
Lib "user32" (ByVal hWnd As Integer, _
ByRef lpRect As RECT) As Integer

#End Region

#Region " 变量定义 "

' 挂载的钩子编号
Private intHook As Integer

#End Region

#Region " 构造函数 "

Public Sub New()
Me.intHook = New Integer
Me.intHook = 0
End Sub

#End Region

#Region " 静态方法 "

'******************************************************************************
'* 概要 ： 挂载系统钩子
'* 参数 ： 无
'* 返回值 ： 无
'* 说明 ： 无
'* 作成日 ： 2006/06/22
'* 作成者 ：
'******************************************************************************
Public Sub Hook()
' 确保卸载上次的钩子
Unhook()

'设置钩子
intHook = SetWindowsHookEx(intWH_CBT, _
AddressOf MessageProcess, _
0, _
AppDomain.GetCurrentThreadId)
End Sub

'******************************************************************************
'* 概要 ： 卸载系统钩子
'* 参数 ： 无
'* 返回值 ： 无
'* 说明 ： 无
'* 作成日 ： 2006/06/22
'* 作成者 ：
'******************************************************************************
Public Sub Unhook()
Dim intResult As Integer

' 判断钩子是否存在
If Me.intHook > 0 Then
'如果存在，卸载钩子
intResult = UnhookWindowsHookEx(Me.intHook)
' 判断是否成功
If intResult <> 0 Then
' 如果成功
Me.intHook = 0
End If
End If
End Sub

'******************************************************************************
'* 概要 ： CBT系统消息发生时的钩子处理
'* 参数 ： (i) nCode 消息类型
'* (i) wParam 消息参数
'* (i) lParam 消息参数
'* 返回值 ： 0
'* 说明 ： 无
'* 作成日 ： 2006/06/22
'* 作成者 ：
'******************************************************************************
Private Function MessageProcess(ByVal nCode As Integer, _
ByVal wParam As Integer, _
ByVal lParam As Integer) As Integer

'变量声明
Dim rcMessageBox As New RECT
Dim rcActiveForm As New RECT
Dim intActiveFormHandle As Integer
Dim intMessageBoxHandle As Integer
Dim intActiveFormWidth As Integer
Dim intActiveFormHeight As Integer
Dim intMessageBoxWidth As Integer
Dim intMessageBoxHeight As Integer
Dim intNewLeft As Integer
Dim intNewTop As Integer

' 判断是否是消息对话框引发的系统消息
If nCode <> intHCBT_ACTIVATE Then
' 如果不是，返回
Return 0
End If

' 当消息对话框出现时，将消息对话框与所在的窗口居中
Try
' 判断当前有没有活动窗口
If Form.ActiveForm Is Nothing Then
' 返回结果
Return 0
End If
' 取得当前活动窗口的句柄
intActiveFormHandle = Form.ActiveForm.Handle.ToInt32
' 消息为HCBT_ACTIVATE时，参数wParam包含的是消息对话框的句柄
intMessageBoxHandle = wParam

' 取得消息对话框的矩形信息
Call GetWindowRect(intMessageBoxHandle, rcMessageBox)
' 取得活动窗口的矩形信息
Call GetWindowRect(intActiveFormHandle, rcActiveForm)

' 计算消息对话框相对于活动窗口居中的新坐标
With rcActiveForm
intActiveFormWidth = .intRight - .intLeft
intActiveFormHeight = .intBottom - .intTop
End With
With rcMessageBox
intMessageBoxWidth = .intRight - .intLeft
intMessageBoxHeight = .intBottom - .intTop
End With
intNewLeft = rcActiveForm.intLeft + (intActiveFormWidth - intMessageBoxWidth) \ 2
intNewTop = rcActiveForm.intTop + (intActiveFormHeight - intMessageBoxHeight) \ 2

'Msgbox居中
Call MoveWindow(intMessageBoxHandle, _
intNewLeft, intNewTop, _
intMessageBoxWidth, intMessageBoxHeight, _
CType(True, Integer))

Catch ex As Exception
' 不处理异常
End Try

' 返回结果
Return 0

End Function

#End Region

End Class

[mostone]

我在回调函数里已经调用了Unhook()

[Tiger_Zhao]

不能在 MessageProcess 中调用 Unhook，否则可能多次触发消息导致多次调用 Unhook，除了第一次，后面的 UnhookWindowsHookEx(intHook) 都不成功

[长江支流]

有这种可能
我在使用GDI+的时候画，因为自己封装了一段DrawText的类，所以会反复的用到，结果用几次后就出现错误，经过很长时间研究发现确实出现了问题，和释放又没有关系，因为你类里面的一个属性不可能在它的实例中不允许多次调用 吧，于是在用到它的时候在内部实例化一次，用完就关，于是就好了。

[mostone]

flygoldfish(长江支流)你好:
不是很明白你的描述,我的代码中,可以算是类的属性的,也只是那个intHook,是一个整型,定义时自动分配内存吧,这个类型应当不需要手工New,再关闭吧! 不过不知道是不是这样: 将这个类的shared方法去除,加上构造函数,每次MessageBox之前,New一个出来,使用后再关掉,是这样吗? 我再试试看.

Tiger_Zhao(VB老鸟)你好:
我刚才修改了Unhook,并进行了Debug,没有出现你所说的情况,我这边每次都返回1,成功unhook掉了.


Public Shared Sub Unhook()
Dim intResult As Integer

' 判断钩子是否存在
If intHook > 0 Then
'如果存在，卸载钩子
intResult = UnhookWindowsHookEx(intHook)
' 判断是否成功
If intResult <> 0 Then
' 如果成功
intHook = 0
End If
End If
End Sub