none
請問如何從VB.net 利用 Windows Message 傳送字串到 VB6 RRS feed

  • 問題

  • 上網找了資料都是VB.net<=>VB.net或VB6<=>VB6,但是我需要從VB.net傳字串到VB6,
    下面貼的code可以VB.net<=>VB.net和VB6<=>VB6,但無法從VB.net傳字串到VB6,

    麻煩各位版友指導,非常感謝!

    以下為VB.net code(發送端)

    Public Structure CopyDataStruct
           Public dwData As Integer   '附加參數
            Public cdData As Integer   '數據大小
            Public lpData As Integer   '數據內容
    End Structure
    Private WN As IntPtr
    Private Const WM_COPYDATA As Integer = &H4A
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
        Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
            WN = FindWindow(vbNullString, TextBox1.Text)
            If WN.Equals(IntPtr.Zero) Then
                Label1.Text = "找不到" & TextBox1.Text
            Else
                Label1.Text = "找到" & TextBox1.Text
            End If
            Label2.Text = WN.ToString
        End Sub
    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
            Dim cdsMessage As New CopyDataStruct
            ' Get an IntPtr which contains the message
            Dim strMessage As String = TextBox7.Text
            Dim ptrMessage As IntPtr = Runtime.InteropServices.Marshal.StringToHGlobalUni(strMessage)
            Dim rtn As Integer
            ' Populate the message into the COPYDATASTRUCT
            cdsMessage.dwData = 3
            cdsMessage.lpData = ptrMessage
            cdsMessage.cdData = System.Text.Encoding.Unicode.GetByteCount(strMessage)
            ' Allocate memory for it and copy the COPYDATASTRUCT into an IntPtr
            Dim ptrStruct As IntPtr = Runtime.InteropServices.Marshal.AllocHGlobal(Runtime.InteropServices.Marshal.SizeOf(cdsMessage))
            Marshal.StructureToPtr(cdsMessage, ptrStruct, True)
            ' Send the windows message to the receiver
            rtn = SendMessage(WN, WM_COPYDATA, Convert.ToInt32(TextBox9.Text), ptrStruct)
            ' Free the memory
            Marshal.FreeHGlobal(ptrStruct)
            TextBox6.Text = rtn
        End Sub

    以下為VB6 code(接收端)

    參考網站:http://support.microsoft.com/kb/176058/en-us

    Private Sub Form_Load()
              gHW = Me.hwnd
              Hook
              Me.Caption = "Target"
              Me.Show
              Label1.Caption = Hex$(gHW)
          End Sub
    Private Sub Form_Unload(Cancel As Integer)
              Unhook
    End Sub
         Type COPYDATASTRUCT
                  dwData As Long
                  cbData As Long
                  lpData As Long
          End Type
          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
          Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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, wParam)
                  
                 'Sleep (3000)
                  WindowProc = CInt(Form1.Text1.Text)
                  Else
                       WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, _
                 lParam)
              End If
         
          End Function
          Sub mySub(lParam As Long, wParam 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$
                  Form1.Print wParam
              End Select
          End Sub

    2013年7月5日 上午 08:35

解答

  • 知道原因了,要轉成byte array,

    也謝謝This的熱心。

        Public Structure CopyDataStructtest
            Public dwData As Integer  '附加參數  
            Public cbData As Integer  '數據大小  
            Public lpData As IntPtr  '數據內容  
        End Structure
        Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
            Dim bytes() As Byte
            Dim encoding As New System.Text.ASCIIEncoding()
            bytes = encoding.GetBytes(TextBox7.Text)
            Dim vCopyDataStruct As New CopyDataStructtest
            vCopyDataStruct.dwData = 3
            vCopyDataStruct.cbData = bytes.Length + 1
            vCopyDataStruct.lpData = Marshal.UnsafeAddrOfPinnedArrayElement(bytes, 0)
            Dim vAddress = Marshal.AllocCoTaskMem(Marshal.SizeOf(vCopyDataStruct))
            Marshal.StructureToPtr(vCopyDataStruct, vAddress, True)
            SendMessage(WN, WM_COPYDATA, Convert.ToInt32(TextBox9.Text), CInt(vAddress))
            Marshal.FreeBSTR(vCopyDataStruct.lpData)
            Marshal.FreeCoTaskMem(vAddress)
        End Sub

    • 已標示為解答 mikuloveu 2013年7月9日 上午 12:23
    2013年7月9日 上午 12:23

所有回覆

  • 知道原因了,要轉成byte array,

    也謝謝This的熱心。

        Public Structure CopyDataStructtest
            Public dwData As Integer  '附加參數  
            Public cbData As Integer  '數據大小  
            Public lpData As IntPtr  '數據內容  
        End Structure
        Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
            Dim bytes() As Byte
            Dim encoding As New System.Text.ASCIIEncoding()
            bytes = encoding.GetBytes(TextBox7.Text)
            Dim vCopyDataStruct As New CopyDataStructtest
            vCopyDataStruct.dwData = 3
            vCopyDataStruct.cbData = bytes.Length + 1
            vCopyDataStruct.lpData = Marshal.UnsafeAddrOfPinnedArrayElement(bytes, 0)
            Dim vAddress = Marshal.AllocCoTaskMem(Marshal.SizeOf(vCopyDataStruct))
            Marshal.StructureToPtr(vCopyDataStruct, vAddress, True)
            SendMessage(WN, WM_COPYDATA, Convert.ToInt32(TextBox9.Text), CInt(vAddress))
            Marshal.FreeBSTR(vCopyDataStruct.lpData)
            Marshal.FreeCoTaskMem(vAddress)
        End Sub

    • 已標示為解答 mikuloveu 2013年7月9日 上午 12:23
    2013年7月9日 上午 12:23