为什么这个VB检测USB设备的程序我一运行就直接退出了呢？

Question

form1
********************************************
Option Explicit
Private Sub Form_Load()
'子类化窗体的消息处理函数
HookForm Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
'程序退出时恢复原窗体处理函数
UnHookForm Me
End Sub
********************************************
标准模块
********************************************
Option Explicit
'子类化窗体消息处理函数时需要使用的API，很常见，不作过多说明。
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)Const GWL_WNDPROC = -4
Const WM_DEVICECHANGE As Long = &H219
Const DBT_DEVICEARRIVAL As Long = &H8000&
Const DBT_DEVICEREMOVECOMPLETE As Long = &H8004&
Const DBT_DEVTYP_VOLUME As Long = &H2 '设备类型：逻辑卷标Private info As DEV_BROADCAST_HDR
Private info_volume As DEV_BROADCAST_VOLUME
Private PrevProc As Long '原来的窗体消息处理函数地址
'与WM_DEVICECHANGE消息相关联的结构体头部信息
Private Type DEV_BROADCAST_HDR
             lSize As Long
             lDevicetype As Long '设备类型
               lReserved As Long
End Type
'设备为逻辑卷时对应的结构体信息
Private Type DEV_BROADCAST_VOLUME
             lSize As Long
             lDevicetype As Long
             lReserved As Long
             lUnitMask As Long '和逻辑卷标对应的掩码
               iFlag As Integer
End Type
Public Sub HookForm(F As Form)
           PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc)
           Debug.Print PrevProc
End Sub
Public Sub UnHookForm(F As Form)
           SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
       '插入USB DISK 则接收到此消息
        Case WM_DEVICECHANGE
            If wParam = DBT_DEVICEARRIVAL Then
                '若插入USBDISK或者映射网络盘等则
                'info.lDevicetype =2
                '即DBT_DEVTYP_VOLUME
                
                '利用参数lParam获取结构体头部信息
                CopyMemory info, ByVal lParam, Len(info)
                
                If info.lDevicetype = DBT_DEVTYP_VOLUME Then
                    
                    CopyMemory info_volume, ByVal lParam, Len(info_volume)
                    
                    '检测到有逻辑卷添加到系统中，则显示该设备根目录下全部文件名
                    ListFiles Chr(GetDriveName(info_volume.lUnitMask)) & ":\"
                    Form1.List1
                End If
            End If            If wParam = DBT_DEVICEREMOVECOMPLETE Then                '若移走USBDISK或者映射网络盘等则
                'info.lDevicetype =2
                '即DBT_DEVTYP_VOLUME
                
                '利用参数lParam获取结构体头部信息
                CopyMemory info, ByVal lParam, Len(info)
                
                If info.lDevicetype = DBT_DEVTYP_VOLUME Then
                    CopyMemory info_volume, ByVal lParam, Len(info_volume)
                    
                    '清除LIST中的内容
                    Form1.List1.Clear
                End If
            End If
End Select
' 调用原来的窗体消息处理函数
WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
End Function
'根据输入的32位LONG型数据（只有一位为1）返回对应的卷标的ASCII数值
'规则是1：A、2：B、4：C等等
Function GetDriveName(ByVal lUnitMask As Long) As Byte
         Dim i As Long
         i = 0
         While lUnitMask Mod 2 <> 1
         lUnitMask = lUnitMask \ 2
         i = i + 1
         Wend 
         GetDriveName = Asc("A") + i
End Function
Function ListFiles(strPath As String, ByRef list As ListBox)
        Dim fso As New Scripting.FileSystemObject
        Dim objFolder As Folder
        Dim objFile As File
        
        Set objFolder = fso.GetFolder(strPath)
        
        For Each objFile In objFolder.Files
                 list.AddItem objFile.Name
        Next
End Function
********************************************
运行时我已经引用了 microsoft scripting runtime

Answer 1

我怀疑你程序大部分都没有执行   
Private Sub Form_Load() 
'子类化窗体的消息处理函数 
HookForm Me 
End Sub 
Private Sub Form_Unload(Cancel As Integer) 
'程序退出时恢复原窗体处理函数 
UnHookForm Me 
End Sub 
******************************************** 
标准模块 
这一段程序是不是使得你写的东西  加载之后立即就被卸载了呢？

Answer 2

我不知道啊！初次使用API，MSDN上有这么一段论述：
重点   当 Visual Basic 处于中断模式时，不允许调用 vtable 方法或 AddressOf 函数。为了保证安全，Visual Basic 仅仅将 0 返回到 AddressOf 函数的调用者。对于子类派生情况，这意味着 WindowProc 将 0 返回到 Windows。Windows 要求它的许多消息返回非 0 值，因此返回的常数 0 将导致 Windows 与 Visual Basic 之间的死锁，从而迫使进程终止。