如何能在vb里截获windows发给vb的关闭程序命令

我写的托盘程序导致不能正常关机，如何能在vb里截获windows发给vb的关闭程序命令,我有多个窗口啊,是不是也有影响

13 个解决方案

#1

处理：
WM_NOTIFY
WM_CLOSE 
WM_DESTROY
WM_QUIT

#2

FORM_UNLOAD事件不行?

#3

主窗体的form_unload，form_queryload不行吗

#4

主窗体的form_unload，form_queryload不行吗
不行，因为我是其他进程关闭这个进程．
处理：
WM_NOTIFY
WM_CLOSE 
WM_DESTROY
WM_QUIT

我不懂如何处理，这个方法我觉的可能可以

#5

哪位能给个例子

#6

我不懂vb如何接收windows发给应用程序的消息如何接收和做处理

#7

你如果要捕获关机消息
就要先子类化窗体，然后就可以拦截一切消息了
至于怎么子类化，你google一下："vb,窗口子类化"

#8

我用了网上的hook函数还是不行，因为我的是个托盘程序，一点托盘就要调用我的hook函数就出错了，实在不知托盘如何解决关机

#9

不是吧，怎么可能
把你的子类化代码贴出来看看

#10

如果不是托盘程序是可以用网上流行的Option Explicit
         
 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal wParam As Long, ByVal lParam As Long) As Long
         
  Public Const GWL_WNDPROC = (-4)
  Public Const WM_ENDSESSION = &H16
  Public Const WM_QUERYENDSESSION = &H11
      
  Public preWinProc     As Long
  Dim tdhefirst As String
   
         
  Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    If (tdhefirst = "") Then
      ' MsgBox "dd"
tdhefirst = "s"
End If
       Dim fno As Long
       fno = FreeFile
  Open "c:\tt2" For Append As fno
    If Msg = WM_QUERYENDSESSION Then
   ' MsgBox "ceshi"




  '这里只是要看看用关机的方式结束程序时，会不会执行到这里
  
  Print #fno, "ceshi" + vbCrLf
 
    
    Debug.Print "QryEnd", wParam, lParam
    Else
      If Msg = WM_ENDSESSION Then
        Print #fno, "aa" + vbCrLf
      ' MsgBox "aa"
      End If
    End If
     Close #fno
    '将之送往原来的Window   Procedure
    wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
  End Function


哎，实在郁闷，因为我对托盘如何控制句炳不理解，好象托盘也是个hook函数，实在不知怎么解决

#11

Option Explicit

Dim countchange As Integer
Dim WithEvents mcTray As cTray
'Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function BWTTp Lib "user32" Alias "BringWindowToTop" (ByVal hwnd As Long) As Long










Private Sub Form_Terminate()

 'Call TCCX '退出托盘
End Sub

Private Sub Form_Unload(Cancel As Integer)
MsgBox "unload"
Dim Ret As Long
  Dim fno As Long

  '取消Message的截取，而使之又只送往原来的Window Procedure
  Ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)

  '这里只是要看看用关机的方式结束程序时，会不会执行到这里
  fno = FreeFile
  Open "c:\tt2" For Append As fno
  Print #fno, "ccc" + vbCrLf
  Close #fno
End Sub

Public Sub mcTray_MouseClick(ByVal Button As Long, ByVal DBClick As Boolean)
    '托盘事件返回
    'Button: 鼠标的按键
    'DBClick: T为双击,F为单击
   ' MsgBox "success"
    Select Case Button
          Case vbLeftButton           '左键单/双击
            If lastmessage <> "" Then
           ' Me.PopupMenu MosRClc '显示右键菜单
           
            Call producemessage(lastmessage, False, False)
           ' MsgBox "double"
            End If
         '   If DBClick = False Then
         '   MsgBox "single"
        '    End If
            Debug.Print "vbLeftButton " & IIf(DBClick = False, "Click", "DBClick")
        Case vbRightButton          '右键单/双击
            If DBClick = False Then Me.PopupMenu MosRClc '显示右键菜单
            Debug.Print "vbRightButton " & IIf(DBClick = False, "Click", "DBClick")
        Case vbMiddleButton         '中键单/双击
            Debug.Print "vbMiddleButton " & IIf(DBClick = False, "Click", "DBClick")
    End Select
End Sub







Private Sub Form_Load()
'Dim strTitle As String * 255



'Exit Sub

On Error Resume Next

 Dim Ret As Long

  '记录原来的Window Procedure的位址
  preWinProc = GetWindowLong(Pic1.hwnd, GWL_WNDPROC)
  '设定form的window Procedure到wndproc
  Ret = SetWindowLong(Pic1.hwnd, GWL_WNDPROC, AddressOf wndproc)




       On Error Resume Next
If App.PrevInstance Then '已经运行了就提示,并关闭
 'MsgBox "      ！程序已经在运行 ！" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "请仔细检查系统任务栏或任务管理器      ", 16, "！程序已经在运行 ！"
  'End
End If
Call init '初试化基本信息
 Set mcTray = New cTray
    With mcTray
        .AddTrayIcon Pic1         '传送一个图片框
        .SetTrayIcon Me.Icon        '传送一个图标
        .SetTrayTip "yeejee小秘书"      '托盘提示文字
    End With

Call ZXHW
 DoEvents '交给操作系统
  '1,发送当前的版本到服务器端,如果列表为空退出,如果是隔着几个版本升级可能会有问题
  Dim returnsource As String
  If username <> "" Then
            returnsource = Inet1.OpenURL(serservice & "?ct=vp&action=autorun&username=" & username & "&password=" & password & "&needphoto=true")    '是同步的不是异步
               Inet1.Cancel
              If returnsource <> "" Then
                     If InStr(returnsource, "$$") > 0 Then  '正常返回的
                                  Call analyseData(returnsource)
                                 
                                  '如果没有登录成功需要人工登录
                             
                                 If futuretodisplay = "failure" Then
                                 ' MsgBox "该用户不存在"
                                 Form4.Show
                                 Else
                                       If oldver = newver Then
                                        If futuretodisplay <> "" Then
                                    '     SetForegroundWindow (Form2)
                                    Call producemessage(formatout(futuretodisplay, "1"), True, True)
                                    futuretodisplay = ""
                                   'PopupMenu Form2.infos, 2, (Screen.Width * 0.98 / Screen.TwipsPerPixelX), (Screen.Height * 0.9 / Screen.TwipsPerPixelY)
                                  End If
                                  
                                  Else
                                   Call producemessage(newverincate, True, True)
                                 ' Form5.Label1.Caption = newverincate
                                 ' Form5.Show '第一次出现
                                   ' PopupMenu Form3.infos, 2, (Screen.Width * 0.98 / Screen.TwipsPerPixelX), (Screen.Height * 0.9 / Screen.TwipsPerPixelY)
                                  End If
                                  
                                 End If
                                  
                      End If
              Else
                     ' MsgBox "服务器异常        "
                     'Call Quit
              End If
 Else
  Form4.Show
 End If
' MsgBox returnsource

'Form5.Show

End Sub

#12

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If x = 513 And y = 0 Then
 ' Call XSJM  '正常显示
Me.PopupMenu MosRClc '显示右键菜单
ElseIf x = 516 And y = 0 Then

Me.PopupMenu MosRClc '显示右键菜单
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 'Call ZXHW: Cancel = 1
 MsgBox "cha"
Call ZXHW: Cancel = 0
' HideMessage.Enabled
 
End Sub

Private Sub Form_Resize()
If Me.WindowState = 1 Then Call ZXHW  '加入托盘并隐藏主界面
End Sub

Private Sub GetInfo_Timer()




' 多一行加180是硬道理,5-10行还可承受多于10行就不好了

'Set Form6.Image1.Picture = LoadPicture("http://img.yeejee.com/uploadimg/2006-09-02/S1157173897886241.jpeg")

' Form6.Show
'Exit Sub

Rem With Sico
  Rem      .zTip = "有一条消息" & vbNullChar
Rem  End With
Rem Shell_MinIco 1, Sico

Rem Sico.zTip = "有一条消息"
count1 = count1 + 1
If (count1 >= maxcount1) Then
             Dim returnsource As String
             If username <> "" Then
                        On Error Resume Next
                       Inet1.Cancel
                       returnsource = Inet1.OpenURL(serservice & "?ct=vp&action=autorun&username=" & username & "&password=" & password)   '是同步的不是异步
                         Inet1.Cancel
                         If returnsource <> "" Then
                                If InStr(returnsource, "$$") > 0 Then  '正常返回的
                                             Call analyseData(returnsource)
                                            
                                             '如果没有登录成功需要人工登录
                                          
                                             
                                        
                                            If futuretodisplay = "failure" Then
                                              'Form4.Show
                                            Else
                                                  If oldver = newver Then
                                                  If futuretodisplay <> "" Then
                                              '    SetForegroundWindow (Form2)
                                                ' Form2.info1.Caption = futuretodisplay
                                              'PopupMenu Form2.infos, 2, (Screen.Width * 0.98 / Screen.TwipsPerPixelX), (Screen.Height * 0.9 / Screen.TwipsPerPixelY)
                                               
                                                Call producemessage(formatout(futuretodisplay, "1"), False, False)
                                                 futuretodisplay = ""
                                               End If
                                             Else
                                               'PopupMenu Form3.infos, 2, (Screen.Width * 0.98 / Screen.TwipsPerPixelX), (Screen.Height * 0.9 / Screen.TwipsPerPixelY)
                                                Call producemessage(newverincate, False, False)
                                             
                                             
                                             
                                             
                                             End If
                                             
                                            End If
                                             
                                 End If
                         Else
                                ' MsgBox "服务器异常        "
                                'Call Quit
                         End If
                         
            Else
             ' Form4.Show
            End If
            count1 = 0
End If
 Rem Form2.Show
End Sub

Private Sub HideMessage_Timer()
count2 = count2 + 1
If (count2 >= maxcount2) Then
            If (futuretodisplay <> "" And futuretodisplay <> "failure") Then
             ' SetForegroundWindow (Form2)
             DoEvents
             
             
            ' Form2.info1.Caption = futuretodisplay
           ' PopupMenu Form2.infos, 2, (Screen.Width * 0.98 / Screen.TwipsPerPixelX), (Screen.Height * 0.9 / Screen.TwipsPerPixelY)
            
            Call producemessage(formatout(futuretodisplay, "1"), False, False)
            futuretodisplay = ""
            Else '可消灭菜单
               ' SetForegroundWindow (Me)
            End If
            count2 = 0
End If

' Form2.info1.Caption = ""
 ' HideMessage.Enabled = False
 Rem  Form2.Hide
End Sub

'Private Sub newver_Timer()
 'PopupMenu Form3.infos, 2, (Screen.Width * 0.98 / Screen.TwipsPerPixelX), (Screen.Height * 0.9 / Screen.TwipsPerPixelY)
'End Sub

Private Sub R200_Click()
Form4.Show
Form4.Text1.Text = ""
Form4.Text2.Text = ""
 'Call XSJM '正常显示工作菜单
End Sub

Private Sub ZXHW() '加入托盘并隐藏主界面
' Shell_MinIco &H0, mcTray: Me.Hide
Me.Hide
End Sub

Private Sub XSJM() '正常显示工作菜单
'Shell_MinIco &H2, mcTray: Me.WindowState = 0: Me.Show: BWTTp (Me.hWnd)
End Sub

Private Sub TCCX() '退出托盘
Inet1.Cancel
WritePrivateProfileString "Main", "Active", "2", getYeejeeIni()
'Shell_MinIco &H2, mcTray:
   mcTray.DelTrayIcon           '删除托盘图标
    Set mcTray = Nothing
    DoEvents
End

End Sub

Private Sub R300_Click()
Call TCCX '退出托盘
End Sub

Private Sub init() '初试化一些资料
UpdateIniPath = getYeejeeIni()  '获取读取
WritePrivateProfileString "Main", "Active", "-1", getYeejeeIni()
 oldver = CStr(ReadIniFile(UpdateIniPath, "version", "ver", "0")) '读取旧版本
 username = CStr(ReadIniFile(UpdateIniPath, "Main", "username", "")) '读取登录信息，如没有让输入
 password = CStr(ReadIniFile(UpdateIniPath, "Main", "words", ""))
 Dim regornot As String
 regornot = CStr(ReadIniFile(UpdateIniPath, "Main", "reg", ""))
 'SetAutoRun (False)
 If regornot = "" Then '说明已经注册
  SetAutoRun (True)
  WritePrivateProfileString "Main", "reg", "true", getYeejeeIni()
 End If
 count1 = 0
 count2 = 0
 
 
End Sub

Private Function ShowHideMe()
    If Me.WindowState = vbNormal Then
        Me.WindowState = vbMinimized
        Me.Hide
    Else
        Me.WindowState = vbNormal
        Me.Show
    End If
End Function
Public Sub producemessage(message1 As String, thefirst As Boolean, needchangephoto As Boolean) 'thefirst看是否能打开多个，多个就要注意初试化form5的位置
       If needchangephoto And myphoto <> "" Then '不然耗时太多，能不改就不改
       Set Form5.Image3.Picture = LoadPicture(myphoto)
      End If
      If thefirst = False Then '可能带来闪烁尽量不要用,除非并发
       Form5.Timer1.Enabled = True
       Form5.Timer2.Enabled = False
       Form5.Top = Screen.Height
      End If
      Form5.Label1.Caption = message1
      On Error Resume Next
DoEvents
Dim oldhand
oldhand = Screen.ActiveForm.hwnd
      lastmessage = message1
Form5.Show
  Call ForceForegroundWindow(oldhand) '不丢焦点
      

      
      
      
      
      
      
      
End Sub
Public Function formatout(message1 As String, stype As String)
If stype = "1" Then
    If message1 <> "" Then
    formatout = Replace(message1, ",", "" & Chr(13) & Chr(10) & "")
    Else: formatout = ""
    End If
End If
End Function

#13

你的托盘怎么搞的那么复杂
在窗口上面加个picturebox，叫picturebox2
声明全局变量
Public T As NOTIFYICONDATA  '这个结构体自己查吧
form_load写如下代码
    
    T.cbSize = Len(T)
    T.hwnd = Picture2.hwnd
    T.uId = 1&
    T.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    T.ucallbackMessage = WM_MOUSEMOVE
    T.hIcon = NotifyIcons.OffLineIcon 'Picture2.Picture
    T.szTip = "ZX Messenger[未登录]" & Chr$(0)
    If Timer1.Enabled = True Then
        Shell_NotifyIcon NIM_ADD, T    '添加托盘图标
    End If


然后在form_unload里写;
    T.cbSize = Len(T)
    T.hwnd = Picture2.hwnd
    T.uId = 1&
    Shell_NotifyIcon NIM_DELETE, T     '删除托盘图标


在Picture2_MouseMove里面写

If (Hex(X) = "1E3C" Or Hex(X) = "1E0F") then
   '鼠标点击处理

end if