VB6とVB.net間のSendMessageについて (ID:103294)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

Vista/VB2008/VB6環境で開発しています。

VB.netからSendMessageで文字列を送り、VB6で受信させるのが目的です。

最初にネットでサンプルを見つけ、試験的にVB6同時で送信側、受信側のソフトを作り成功しました。
その後、送信側のみVB.net(2008)で別途作りました。
その結果受信側では何の反応も無く、受信できません。

問題点を教えていただけますか？

送信側VB.net
Public Class Form1
    Structure COPYDATASTRUCT
        Dim dwData As Integer
        Dim cbData As Integer
        Dim lpData As String 
    End Structure

Public Const WM_COPYDATA As Int32 = &H4A

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
        (ByVal hwnd As Integer, ByVal msg As Integer, _
         ByVal wParam As Integer, ByVal lParam As COPYDATASTRUCT) As Integer

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

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Dim sdtCOPYDATASTRUCT As COPYDATASTRUCT
        sdtCOPYDATASTRUCT.dwData = 0
        sdtCOPYDATASTRUCT.lpData = TextBox1.Text
        sdtCOPYDATASTRUCT.cbData = TextBox1.Text.Length + 1

Dim hWndTo As Integer
        Dim l As Long
        hWndTo = FindWindow(vbNullString, "受信側フォーム名")
        If hWndTo <> 0 Then
            l = PostMessage(hWndTo, WM_COPYDATA, 0, sdtCOPYDATASTRUCT)
        End If
    End Sub
End Class

受信側VB6
'フォーム
Private Sub Form_Activate()
    Call Hook(Me.hwnd)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Call UnHook(Me.hwnd)
End Sub

'モジュール
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 = (-4)

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 Const WM_COPYDATA = &H4A

Public phWnd As Long

Public Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal iSize&)

Type COPYDATASTRUCT
        dwData As Long
        cbData As Long
        lpData As Long
End Type

'-------------------------------------------------------
'
'-------------------------------------------------------
Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Static bolWndProcCheck As Boolean
    Dim str As String
    Dim lngret As Long
    Dim sdtCOPYDATASTRUCT As COPYDATASTRUCT
    
    If Not bolWndProcCheck Then
        bolWndProcCheck = True
        Select Case uMsg
        Case WM_COPYDATA
            Call memcpy(ByVal VarPtr(sdtCOPYDATASTRUCT), ByVal lParam&, LenB(sdtCOPYDATASTRUCT))
            str = String$(sdtCOPYDATASTRUCT.cbData, vbNullChar)
            Call memcpy(ByVal str, ByVal sdtCOPYDATASTRUCT.lpData, sdtCOPYDATASTRUCT.cbData)
            Form1.Text1.Text = str
        End Select
        bolWndProcCheck = False
    End If
    WndProc = CallWindowProc(phWnd, hwnd, uMsg, wParam, lParam)
End Function

Public Sub Hook(hwnd As Long)
    phWnd = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Public Sub UnHook(hwnd As Long)
    Dim lngret As Long
    If phWnd <> 0 Then
        lngret = SetWindowLong(hwnd, GWL_WNDPROC, phWnd)
    End If
End Sub

←解決時は質問者本人がここをチェックしてください。

戻る