有没有办法调用:受保护的覆盖VB6中的void WndProc(ref Message m)?

时间:2014-01-20 08:51:51

标签: vba vb6

我正在C#.net中实现一个将消息传递给VB6应用程序的应用程序。

为了测试我在C#.NET中创建了两个应用程序: - 一个发送消息,第二个接收消息。

接收应用程序(C#.NET)使用以下函数来捕获消息: -

Protected Override void WndProc(ref Message m)

我现在需要在VB6中实现这个接收器应用程序..我们如何在VB6中实现Protected Override void WndProc(ref message m)?还是有其他选择吗?

2 个答案:

答案 0 :(得分:1)

在VB6中可以覆盖默认的Windows程序,并且称为 Subclassing

在一个模块中:

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 As Long = (-4)
Private originalWindowProcAddr As Long

Public Sub subclassForm(hwnd As Long)
    '// replace existing windows procedure save its address
    originalWindowProcAddr = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub

Public Function NewWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Debug.Print "received message for:", hwnd, "message:", uMsg

    '// forward message to default
    NewWindowProc = CallWindowProc(originalWindowProcAddr, hwnd, uMsg, wParam, lParam)
End Function

Public Sub unSubclassForm(hwnd As Long)
    '// must tidy up by restoring the original window proc
    SetWindowLong hwnd, GWL_WNDPROC, originalWindowProcAddr
End Sub

以表格

Private Sub Form_Load()
   subclassForm Me.hwnd
End Sub

Private Sub form_Unload(Cancel As Integer)
    unSubclassForm Me.hwnd
End Sub

无法调用unSubclassForm将导致VB IDE崩溃,并进入调试模式。

答案 1 :(得分:0)

我遵循这个方法: - http://support.microsoft.com/kb/176058/en-us

如何使用SendMessage在应用程序之间传递字符串数据

内容 使用Visual Basic实现进程间通信的方法有很多种。除非您建立OLE自动化客户端服务器关系,否则很难干净地处理字符串数据。主要原因是32位应用程序在单独的地址空间中运行,因此一个应用程序中字符串的地址对于不同地址空间中的另一个应用程序没有意义。使用SendMessage()API函数传递WM_COPYDATA消息可以避免此问题。

本文演示了如何使用带有WM_COPYDATA消息的SendMessage API函数将字符串数据从一个应用程序传递到另一个应用程序。

警告:本文中讨论了以下一个或多个功能; VarPtr,VarPtrArray,VarPtrStringArray,StrPtr,ObjPtr。 Microsoft技术支持不支持这些功能。它们未在Visual Basic文档中记录,并且在“知识库”文章中“按原样”提供。 Microsoft不保证在将来的Visual Basic版本中可以使用它们。

Visual Basic不支持Visual C ++方式的指针和转换。为了将字符串数据从一个Visual Basic应用程序传递到另一个Visual Basic应用程序,必须在将Unicode字符串传递给另一个应用程序之前将其转换为ASCII。然后,另一个应用程序必须将ASCII字符串转换回Unicode。

以下总结了如何将字符串数据从一个应用程序传递到另一个应用程序。 分步示例 使用CopyMemory()API将字符串转换为字节数组。 使用VarPtr()内部函数获取字节数组的地址,并将字节数组的地址和长度复制到COPYDATASTRUCT结构中。 使用WM_COPYDATA消息将COPYDATASTRUCT传递给另一个应用程序,设置另一个应用程序以接收消息。 使用CopyMemory()解压缩目标系统上的结构,并使用StrConv()内部函数将字节数组转换回字符串。 下一节将向您展示如何创建示例程序,以演示将字符串数据从一个应用程序传递到另一个应用程序。 创建示例的步骤 要创建此示例,请创建两个单独的项目;发送项目和目标项目。

创建目标应用程序: 在Visual Basic中启动一个新的标准EXE项目。 Form1默认创建。该项目将成为您的目标应用程序。 将Label控件添加到Form 1。 将以下代码复制到Form 1的代码窗口:       Private Sub Form_Load()           gHW = Me.hWnd           钩           Me.Caption =“目标”           Me.Show           Label1.Caption = Hex $(gHW)       结束子

  Private Sub Form_Unload(Cancel As Integer)
      Unhook
  End Sub

将一个模块添加到项目中,并将以下代码粘贴到Module1代码窗口中:      键入COPYDATASTRUCT               dwData As Long               cbData As Long               lpData As Long       结束类型

  Public Const GWL_WNDPROC = (-4)
  Public Const WM_COPYDATA = &H4A
  Global lpPrevWndProc As Long
  Global gHW As Long

  'Copies a block of memory from one location to another.

  Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
     (hpvDest As Any, hpvSource As Any, ByVal cbCopy 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 Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
     (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As _
     Long) As Long

  Public Sub Hook()
      lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
      AddressOf WindowProc)
      Debug.Print lpPrevWndProc
  End Sub

  Public Sub Unhook()
      Dim temp As Long
      temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
  End Sub

  Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long
      If uMsg = WM_COPYDATA Then
          Call mySub(lParam)
      End If
      WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, _
         lParam)
  End Function

  Sub mySub(lParam As Long)
      Dim cds As COPYDATASTRUCT
      Dim buf(1 To 255) As Byte

      Call CopyMemory(cds, ByVal lParam, Len(cds))

      Select Case cds.dwData
       Case 1
          Debug.Print "got a 1"
       Case 2
          Debug.Print "got a 2"
       Case 3
          Call CopyMemory(buf(1), ByVal cds.lpData, cds.cbData)
          a$ = StrConv(buf, vbUnicode)
          a$ = Left$(a$, InStr(1, a$, Chr$(0)) - 1)
          Form1.Print a$
      End Select
  End Sub

保存项目并最小化Visual Basic IDE。

创建发送应用程序

启动Visual Basic IDE的第二个实例,并在Visual Basic中创建一个新的标准EXE项目。 Form1默认创建。

将CommandButton添加到Form1。

将以下代码复制到Form1的代码窗口:       私人类型COPYDATASTRUCT               dwData As Long               cbData As Long               lpData As Long       结束类型

  Private Const WM_COPYDATA = &H4A

  Private Declare Function FindWindow Lib "user32" Alias _
     "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
     As String) As Long

  Private Declare Function SendMessage Lib "user32" Alias _
     "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal _
     wParam As Long, lParam As Any) As Long

  'Copies a block of memory from one location to another.
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
     (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

  Private Sub Command1_Click()
      Dim cds As COPYDATASTRUCT
      Dim ThWnd As Long
      Dim buf(1 To 255) As Byte

  ' Get the hWnd of the target application
      ThWnd = FindWindow(vbNullString, "Target")
      a$ = "It Works!"
  ' Copy the string into a byte array, converting it to ASCII
      Call CopyMemory(buf(1), ByVal a$, Len(a$))
      cds.dwData = 3
      cds.cbData = Len(a$) + 1
      cds.lpData = VarPtr(buf(1))
      i = SendMessage(ThWnd, WM_COPYDATA, Me.hwnd, cds)
  End Sub

  Private Sub Form_Load()
  ' This gives you visibility that the target app is running
  ' and you are pointing to the correct hWnd
      Me.Caption = Hex$(FindWindow(vbNullString, "Target"))
  End Sub

保存项目。

运行样本

恢复目标应用程序,然后按F5键以运行项目。请注意标签中显示的hWnd值。

恢复发送应用程序,然后按F5键运行该项目。验证表单标题中的hWnd是否与目标应用程序上的标签中的hWnd匹配。单击CommandButton,文本消息应显示在目标应用程序的窗体上。