VB中WindowProc怎么用？

我想请问一下vb中的WindowProc函数怎么用？我想用它来响应wm_devicechange消息。WindowProc函数要在哪里定义？能否给代码参考一下？

解决方案 »

  1.   

    象这样用（但是还要用另一个API: SetWindowLong() 把消息处理函数设置成你自己的WndProc()才起得到作用）
    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 LongPublic Function WndProc(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        If ........ Then
            .............
            WndProc = 0
            'Exit Function
        Else
           WndProc = CallWindowProc(OldProc, Hwnd, Msg, wParam, lParam)
        End If
    End Function
      

  2.   

    大概的用法是这样:
    '标准模块中,   
        
      Option   Explicit   
        
      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   Function   SetWindowLong   Lib   "user32"   Alias   "SetWindowLongA"   (ByVal   hwnd   As   Long,   ByVal   nIndex   As   Long,   ByVal   dwNewLong   As   Long)   As   Long   
      Public   Const   GWL_WNDPROC   As   Long   =   (-4)   
        
        
        
      Public   lpPrevProc   As   Long   
        
      Public   Function   WindowProc(ByVal   hw   As   Long,   ByVal   uMsg   As   Long,   ByVal   wParam   As   Long,   ByVal   lParam   As   Long)   As   Long   
               On   Error   Resume   Next   
             WindowProc   =   CallWindowProc(lpPrevProc,   hw,   uMsg,   wParam,   lParam)   
      End   Function   
        
      Public   Sub   Hook(ByVal   nHwnd   As   Long)   '将程序勾入消息环中   
                 lpPrevProc   =   SetWindowLong(nHwnd,   GWL_WNDPROC,   AddressOf   WindowProc)   
      End   Sub   
        
      Public   Sub   UnHook(nHwnd   As   Long)   
               Call   SetWindowLong(nHwnd,   GWL_WNDPROC,   lpPrevProc)   
      End   Sub   
        
        
      '然后在窗体中   
        
      Option   Explicit   
        
      Private   Sub   Form_Load()   
                Hook   Me.hwnd   
      End   Sub   
        
      Private   Sub   Form_QueryUnload(Cancel   As   Integer,   UnloadMode   As   Integer)   
                UnHook   Me.hwnd   
      End   Sub   
      

  3.   


    VB检测到U盘的插拔(源代码) 
      现在网络上流传着一些能实时检测到U盘插拔消息并能在其插入后伺机拷贝其中文档资料的恶意程序，通过一个简单的VB程序演示一下核心操作过程并借机把实现原理作一个简洁的说明。（可以编译成系统服务后随开机启动哦，哈哈哈）   事实上当U盘（实际上不局限于U盘，所有能在系统中获得逻辑卷标的设备都适用）插入视窗系统的机器后操作系统将发送一个WM_DEVICECHANGE的广播消息，因此只要在相应的消息处理过程中拦截该信息并加以处理就能实时检测到U盘的插拔，之后即可进行预设的有关处理动作了。   熟悉WINDOWS消息处理过程的人都知道，操作系统发送有关消息时还会附带上两个重要的参数：wParam、lParam，因此WM_DEVICECHANGE也不例外，当该消息发生时，wParam里的内容是指示设备变化的具体事件类别，在我们的演示程序里只需要关心DBT_DEVICEARRIVAL和DBT_DEVICEREMOVECOMPLETE这两个事件，前者表示新设备已经插入机器并能正常使用了，后者表示设备已经被物理移除了；lParam的内容实际上是一个地址，指向一个结构体，该结构的具体细节由插入系统的设备类型决定，这里有个需要注意的地方，即不论设备类型是什么，该结构的前面三个LONG型成员是固定的，因此我们可以先取得这三个成员的内容，再根据第二个成员的数值来确定新设备类型，然后再获取全部成员的内容。 
    以下是这个VB演示程序的代码，效果就是检测到设备插入后即把该设备根目录下的全部文件名显示在LISTBOX里面。 
    模块代码： 
    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 
    '与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 info As DEV_BROADCAST_HDR 
    Public info_volume As DEV_BROADCAST_VOLUME 
    Public PrevProc As Long   ‘原来的窗体消息处理函数地址 
    Public Sub HookForm(F As Form) 
    PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc) 
    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 
    '显示插入逻辑卷根目录的文件名列表，需要在工程里引用Microsoft Scripting Runtime库。 
    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 
    窗体Form1代码： 
    Option Explicit 
    Private Sub Form_Load() 
    '子类化窗体的消息处理函数 
    HookForm Me 
    End Sub 
    Private Sub Form_Unload(Cancel As Integer) 
    '程序退出时恢复原窗体处理函数 
    UnHookForm Me 
    End Sub 
    备注：本示例程序不仅仅能检测U盘的插入，对CDROM、网络映射盘等设备也会作出同样的反应，如果需要只检测U盘，则需要在If info.lDevicetype = 
    DBT_DEVTYP_VOLUME 
    处再对iFlag结构成员作检测，其数值为0时表示设备为U盘。另外根据微软的解释，软盘的插拔是不会有引发该消息的，原因是只有支持软弹出技术的设备才会引发该消息。 
     
      

  4.   

    再给你一个简单的例子。
    form1的窗体代码：
    '将自己的菜单添加到窗体标题栏控制盒菜单（系统菜单）中
    Option ExplicitPrivate Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
    Private Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long
     
    Private Const MF_BYCOMMAND = &H0&
    Private Const MF_BYPOSITION = &H400&
    Private Const MF_STRING = &H0&
    Private Const MF_SEPARATOR = &H800&
     
    Private Sub Form_Load()
            InsertMenu GetSystemMenu(Me.hWnd, False), 0, MF_BYPOSITION Or MF_SEPARATOR, 2001, ""
            InsertMenu GetSystemMenu(Me.hWnd, False), 0, MF_BYPOSITION Or MF_STRING, 2002, "About Me(&A)"
            '安装子类化入口
            Call Init(Me.hWnd)
    End Sub
     
    Private Sub Form_Unload(Cancel As Integer)
            '卸载子类化
            Call Terminate(Me.hWnd)
    End Sub标准模块module1.bas：
    Option Explicit
                        
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) 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 Const GWL_WNDPROC = (-4&)
     
    Dim PrevWndProc As Long
     
    Private Const WM_SYSCOMMAND = &H112
    Private Const WM_DESTROY = &H2
    '子类化入口
    Public Sub Init(hWnd As Long)
           PrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf SubWndProc)
    End Sub
    '子类化出口
    Public Sub Terminate(hWnd As Long)
           Call SetWindowLong(hWnd, GWL_WNDPROC, PrevWndProc)
    End Sub
    '新的窗口消息处理过程，将被插入到默认处理过程之前
    Private Function SubWndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
            If Msg = WM_DESTROY Then Terminate (Form1.hWnd)
            If wParam = 2002 Then
               MsgBox "我是东方之珠", vbInformation, "hahaha"
            End If
            '调用默认的窗口处理过程
            SubWndProc = CallWindowProc(PrevWndProc, hWnd, Msg, wParam, lParam)
    End Function