我在写一个用到托盘的程序,需要hook窗口函数.但是我一运行程序就会退出程序,在vb中直接运行时连vb也会跳出。请问各位前辈这是怎么回事。关于托盘的模块代码如下:
''''''''''''''''''''''''''''
'加载的API函数和常数
''''''''''''''''''''''''''''
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private 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
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Type NOTIFYICONDATA
        cbSize As Long
        hwnd As Long
        uid As Long
        uFlags As Long
        uCallbackMessage As Long
        hicon As Long
        szTip As String * 64
End TypePrivate Const NOTIFYICON_VERSION = 3
Private Const NOTIFYICON_OLDVERSION = 0Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2Private Const NIM_SETFOCUS = &H3
Private Const NIM_SETVERSION = &H4
 
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10
 
Private Const NIS_HIDDEN = &H1
Private Const NIS_SHAREDICON = &H2
 Private Const NIIF_NONE = &H0
Private Const NIIF_WARNING = &H2
Private Const NIIF_ERROR = &H3
Private Const NIIF_INFO = &H1Private Type POINTAPI
     x As Long
     y As Long
End TypePrivate Type Msg
     hwnd As Long
     message As Long
     wParam As Long
     lParam As Long
     time As Long
     pt As POINTAPI
End TypePrivate Const WM_USER = &H400
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_LBUTTONDOWN = &H201
Private Const GWL_WNDPROC = -4
'''''''''''''''''''''''''''
'私有数据
'''''''''''''''''''''''''''
Private lpPrevWndProc As Long
Private FatherFormHwnd As Long
Private nidata As NOTIFYICONDATA
Private Const WM_TRAYICONBUTTONDOWN = WM_USER + 101
''''''''''''''''''''''''
'窗口函数
'''''''''''''''''''''''
Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If hw = Form1.hwnd And uMsg = WM_TRAYICONBUTTONDOWN Then '检测到鼠标点动托盘图标
        Select Case lParam
           Case WM_RBUTTONDOWN '鼠标右键按下
           Case WM_LBUTTONDOWN '鼠标左键按下           Case Else
        End Select
    Else '调用缺省窗口指针
'            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    End If
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    
End Function
'''''''''''''''''''''''''''''
'公共函数
''''''''''''''''''''''''''''Public Sub setFatherFormHwnd(hwnd As Long)
   FatherFormHwnd = hwnd
End SubPublic Function AddTrayIcon(uid As Long, hicon As Long, szTip As String) As Long
    If Len(szTip) > 64 Then
        szTip = Left(szTip, 64)
    End If
    
    With nidata
        .cbSize = Len(NOTIFYICONDATA)
        .hwnd = FatherFormHwnd
        .hicon = hicon
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uid = uid
        .uCallbackMessage = WM_TRAYICONBUTTONDOWN
        .szTip = szTip
    End With
        
    AddTrayIcon = Shell_NotifyIcon(NIM_ADD, nidata)
     
    lpPrevWndProc = SetWindowLong(FatherFormHwnd, GWL_WNDPROC, AddressOf WindowProc)
End FunctionPublic Function deltrayicon(uid As Long, hicon As Long) As Long
    With nidata
        .cbSize = Len(NOTIFYICONDATA)
        .hwnd = FatherFormHwnd
        .hicon = hicon
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uid = uid
        .uCallbackMessage = WM_TRAYICONBUTTONDOWN
        .szTip = ""
    End With
    
    deltrayicon = Shell_NotifyIcon(NIM_DELETE, nidata)
    
    SetWindowLong FatherFormHwnd, GWL_WNDPROC, lpPrevWndProc
End Function

解决方案 »

  1.   

    这是一个例子,楼主看看。
    http://www.wowor.net/bbs/up/files/2004316_mouseinductor.exe
      

  2.   

    还有就是去掉SetWindowLong FatherFormHwnd, GWL_WNDPROC, lpPrevWndProc
    就没问题
      

  3.   

    '把修改後的代碼貼上來,模塊中:
    Option ExplicitPrivate Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
    Private 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
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Type NOTIFYICONDATA
            cbSize As Long
            hwnd As Long
            uid As Long
            uFlags As Long
            uCallbackMessage As Long
            hicon As Long
            szTip As String * 64
    End TypePrivate Const NOTIFYICON_VERSION = 3
    Private Const NOTIFYICON_OLDVERSION = 0Private Const NIM_ADD = &H0
    Private Const NIM_MODIFY = &H1
    Private Const NIM_DELETE = &H2Private Const NIM_SETFOCUS = &H3
    Private Const NIM_SETVERSION = &H4
     
    Private Const NIF_MESSAGE = &H1
    Private Const NIF_ICON = &H2
    Private Const NIF_TIP = &H4Private Const NIF_STATE = &H8
    Private Const NIF_INFO = &H10
     
    Private Const NIS_HIDDEN = &H1
    Private Const NIS_SHAREDICON = &H2
     Private Const NIIF_NONE = &H0
    Private Const NIIF_WARNING = &H2
    Private Const NIIF_ERROR = &H3
    Private Const NIIF_INFO = &H1Private Type POINTAPI
         x As Long
         y As Long
    End TypePrivate Type Msg
         hwnd As Long
         message As Long
         wParam As Long
         lParam As Long
         time As Long
         pt As POINTAPI
    End TypePrivate Const WM_USER = &H400
    Private Const WM_RBUTTONDOWN = &H204
    Private Const WM_LBUTTONDOWN = &H201
    Private Const GWL_WNDPROC = -4
    '''''''''''''''''''''''''''
    '私有数据
    '''''''''''''''''''''''''''
    Private lpPrevWndProc As Long
    Private FatherFormHwnd As Long
    Private nidata As NOTIFYICONDATA
    Private Const WM_TRAYICONBUTTONDOWN = WM_USER + 101
    ''''''''''''''''''''''''
    '窗口函数
    '''''''''''''''''''''''
    Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If hw = Form1.hwnd And uMsg = WM_TRAYICONBUTTONDOWN Then '检测到鼠标点动托盘图标
            Select Case lParam
               Case WM_RBUTTONDOWN '鼠标右键按下
                MsgBox "右鍵按下"
               Case WM_LBUTTONDOWN '鼠标左键按下
                MsgBox "左鍵按下"
               Case Else
            End Select
        Else '调用缺省窗口指针
    '            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
        End If
        WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
        
    End Function
    '''''''''''''''''''''''''''''
    '公共函数
    ''''''''''''''''''''''''''''Public Sub setFatherFormHwnd(hwnd As Long)
       FatherFormHwnd = hwnd
    End SubPublic Function AddTrayIcon(uid As Long, hicon As Long, szTip As String) As Long
        If Len(szTip) > 64 Then
            szTip = Left(szTip, 64)
        End If
        
        With nidata
            .cbSize = Len(nidata)
            .hwnd = FatherFormHwnd
            .hicon = hicon
            .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
            .uid = uid
            .uCallbackMessage = WM_TRAYICONBUTTONDOWN
            .szTip = szTip
        End With
            
        AddTrayIcon = Shell_NotifyIcon(NIM_ADD, nidata)
         
        lpPrevWndProc = SetWindowLong(FatherFormHwnd, GWL_WNDPROC, AddressOf WindowProc)
    End FunctionPublic Function deltrayicon(uid As Long, hicon As Long) As Long
        With nidata
            .cbSize = Len(nidata)
            .hwnd = FatherFormHwnd
            .hicon = hicon
            .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
            .uid = uid
            .uCallbackMessage = WM_TRAYICONBUTTONDOWN
            .szTip = ""
        End With
        
        deltrayicon = Shell_NotifyIcon(NIM_DELETE, nidata)
        
        SetWindowLong FatherFormHwnd, GWL_WNDPROC, lpPrevWndProc
    End Function' 窗體中,需兩個 CommandButton 按鈕,名爲 cmdAddIcon,cmdDelIcon'然後添加圖標的時候' 設置父窗體句柄
    Private Sub Form_Load()
        ' 這一句話一定要寫在添加圖標之前
        setFatherFormHwnd Me.hwnd
    End Sub' 添加圖標
    Private Sub cmdAddIcon_Click()
        AddTrayIcon 1, Me.Icon, "test" & vbNullChar
    End Sub' 刪除圖標
    Private Sub cmdDelIcon_Click()
        deltrayicon 1, Me.Icon
    End Sub
    '    主要改動的地方是AddTrayIcon過程和deltrayicon過程中的
    '    .cbSize = Len(NOTIFYICONDATA)
    '         改爲
    '    .cbSize = Len(nidata)