当前位置:编程学习 > C#/ASP.NET >>

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

上網找了資料都是VB.net<=>VB.net或VB6<=>VB6,但是我需要從VB.net傳字串到VB6,
下面貼的code可以VB.net<=>VB.net和VB6<=>VB6,但無法從VB.net傳字串到VB6,
幾天試下來都沒什麼頭緒,麻煩各位前輩們指導,非常感謝!!!
VB.net:(發送端)

    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 Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.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 
        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:(接收字串)參考網站:http://support.microsoft.com/kb/176058/en-us
Form1

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

Moudule

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
Visual Basic 6.0 windows message VB.NET  windows message --------------------编程问答-------------------- 找到問題了,VB.net程式修改如以下:
要變成 byte array
  
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
--------------------编程问答-------------------- Thanx Very nice
--------------------编程问答-------------------- 厉害啊,为什么两个都有源代码的程序偏偏要用Windows Message来通信呢?
补充:.NET技术 ,  VB.NET
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,