C# と VB.NET の質問掲示板

以下の、Win7環境で作成したVB2005のSendMessageプログラムを実行すると、2つの画面間で正常に
メッセージの送受信ができるところまで確認しています。

以下のEXEをWinXP環境で実行したところ
pinvokestackimbalanceエラーとなります。
Win7環境では問題なかったのに、WinXPではエラーとなる原因、対処方法ご教示お願いいたします。
Win7、WinXPともにVB2005の環境があります。


Imports System
Imports System.Runtime.InteropServices

Public Class FomSendMessage
    Public Const SMTO_BLOCK = &H1
    Public Const SMTO_ABORTIFHUNG = &H2
    Public Const WM_NULL = &H0
    Public Const WM_CLOSE = &H10
    Public Const PROCESS_ALL_ACCESS = &H1F0FFF
    Public Const WM_COPYDATA As Int32 = &H4A
    Public Const WM_USER As Int32 = &H400

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Private Shared Function FindWindow( _
         ByVal lpClassName As String, _
         ByVal lpWindowName As String) As IntPtr
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Private Shared Function SendMessageTimeout( _
                       ByVal hwnd As IntPtr, _
                       ByVal msg As Integer, _
                       ByVal wParam As IntPtr, _
                       ByVal lParam As COPYDATASTRUCT, _
                       ByVal fuFlags As Integer, _
                       ByVal uTimeout As Integer, _
                       ByVal lpdwResult As Integer) As Integer
    End Function

    'COPYDATASTRUCT構造体
    Public Structure COPYDATASTRUCT
        Public dwData As IntPtr        '送信するビット値
        Public cbData As Integer        'lpDataのバイト数
        Public lpData As String         '送信するデータへのポインタ(0も可能)
    End Structure

送信側----------------------------------------------

    '送信ボタン押下
    Private Sub butSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butSend.Click
        Dim result As Long = 0
        Dim lngResult As Long

        '相手のウィンドウハンドルを取得します
        Dim hWnd As Integer
        'txtName.Textには予め相手のウィンドウ名を設定しておきます。
        hWnd = FindWindow(Nothing, txtName.Text)

        If hWnd = 0 Then
            'ハンドルが取得できなかった
            MessageBox.Show("相手Windowのハンドルが取得できません")
            Return
        End If

        '文字列メッセージを送信します
        If txtMessage.Text <> String.Empty Then
            '送信データをByte配列に格納
            Dim cds As COPYDATASTRUCT
            cds.dwData = 0        '使用しない
            cds.lpData = txtMessage.Text 'テキストのポインターをセット
            cds.cbData = (txtMessage.Text.Length + 1) * 2     '長さをセット

            '文字列を送る
            result = SendMessageTimeout(hWnd, _
                                        WM_COPYDATA, _
                                        IntPtr.Zero, _
                                        cds, _
                                        SMTO_ABORTIFHUNG And SMTO_BLOCK, _
                                        2, _
                                        lngResult)
        End If

    End Sub


受信側----------------------------------------------

    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)

        Select Case m.Msg

            Case WM_COPYDATA
                '文字が送信されて来た
                Dim mystr As COPYDATASTRUCT = New COPYDATASTRUCT()
                Dim mytype As Type = mystr.GetType()
                mystr = CType(m.GetLParam(mytype), COPYDATASTRUCT)
                txtMessage2.Text = mystr.lpData
        End Select

        MyBase.WndProc(m)

    End Sub

End Class

■No65246 (魔界の仮面弁士 さん) に返信
> 何故、Int64 型を使っているのでしょうか?
> FindWindow を As IntPtr で宣言しているのに、
> 何故、Int32 型の変数で受けているのでしょうか?

参考にしたサンプルを鵜呑みにしていたというと正直な回答ですが
お恥ずかしい限りです。確かに型があっていませんでした。
正しく以下に訂正しました。

> 
> 
>>   'COPYDATASTRUCT構造体
>>   Public Structure COPYDATASTRUCT
>>       Public dwData As IntPtr        '送信するビット値
>>       Public cbData As Integer        'lpDataのバイト数
>>       Public lpData As String         '送信するデータへのポインタ(0も可能)
>>   End Structure
> lpData を String 型で渡さないようにしましょう。
> http://www.atmarkit.co.jp/bbs/phpBB/viewtopic.php?topic=31174&forum=7
> http://bbs.wankuma.com/index.cgi?mode=al2&namber=8322&KLOG=8

上記のサイトを参考に、以下に書き換えてみました。
Win7で実行すると成功します。
WinXPで実行するとやはりエラーとなりました。
「PInvoke 関数 'SendMessage受信!SendMessage受信.FomSendMessage::SendMessageTimeout' がスタックを不安定にしています。
PInvoke シグネチャがアンマネージ ターゲット シグネチャに一致していないことが原因として考えられます。
呼び出し規約、および PInvoke シグネチャのパラメータが
ターゲットのアンマネージ シグネチャに一致していることを確認してください。」
SendMessageTimeoutが、誤っているのかちょっと試行錯誤してみます。

    Public Const SMTO_BLOCK = &H1
    Public Const SMTO_ABORTIFHUNG = &H2
    Public Const WM_NULL = &H0
    Public Const WM_CLOSE = &H10
    Public Const PROCESS_ALL_ACCESS = &H1F0FFF
    Public Const WM_COPYDATA As Int32 = &H4A
    Public Const WM_USER As Int32 = &H400

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Private Shared Function FindWindow( _
         ByVal lpClassName As String, _
         ByVal lpWindowName As String) As IntPtr
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Private Shared Function SendMessageTimeout( _
                       ByVal hwnd As IntPtr, _
                       ByVal msg As Integer, _
                       ByVal wParam As IntPtr, _
                       ByVal lParam As COPYDATASTRUCT, _
                       ByVal fuFlags As Integer, _
                       ByVal uTimeout As Integer, _
                       ByVal lpdwResult As Integer) As Integer
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Public Shared Function SendMessage( _
                            ByVal hWnd As IntPtr, _
                            ByVal wMsg As Integer, _
                            ByVal wParam As IntPtr, _
                            ByRef lParam As COPYDATASTRUCT) As IntPtr
    End Function

    'COPYDATASTRUCT構造体
    Public Structure COPYDATASTRUCT
        Public dwData As IntPtr
        Public cbData As Integer
        Public lpData As IntPtr
    End Structure

送信側---------------------------------

    '送信ボタン押下
    Private Sub butSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butSend.Click
        Dim result As IntPtr
        Dim lngResult As Long

        '相手のウィンドウハンドルを取得します
        Dim hWnd As IntPtr
        hWnd = FindWindow(Nothing, txtName.Text)

        If hWnd = 0 Then
            'ハンドルが取得できなかった
            MessageBox.Show("相手Windowのハンドルが取得できません")
            Return
        End If

        '文字列メッセージを送信します
        If txtMessage.Text <> String.Empty Then
            '送信データをByte配列に格納
            Dim cds As COPYDATASTRUCT
            cds.dwData = 0
            cds.lpData = Marshal.StringToHGlobalUni(txtMessage.Text)
            cds.cbData = (txtMessage.Text.Length + 1) * 2

            '文字列を送る
            result = SendMessageTimeout(hWnd, _
                                        WM_COPYDATA, _
                                        IntPtr.Zero, _
                                        cds, _
                                        SMTO_ABORTIFHUNG And SMTO_BLOCK, _
                                        2, _
                                        lngResult)
        End If

    End Sub

受信側---------------------------------
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)

        Select Case m.Msg

            Case WM_COPYDATA
                '文字が送信されて来た
                Dim cds As COPYDATASTRUCT
                cds = CType(Marshal.PtrToStructure(m.LParam, GetType(COPYDATASTRUCT)), COPYDATASTRUCT)
                txtMessage2.Text = Marshal.PtrToStringUni(cds.lpData)
        End Select

        MyBase.WndProc(m)

    End Sub

SendMessageTimeoutがPINVOKE.NETで調べたところ誤っていたようでした。
正しい使い方がわからないので試行錯誤しています。

上記のコードのSendMessageだとWinXPでも通信が成功しました。


    <Flags()> _
    Public Enum SendMessageTimeoutFlags
        SMTO_NORMAL = 0
        SMTO_BLOCK = 1
        SMTO_ABORTIFHUNG = 2
        SMTO_NOTIMEOUTIFNOTHUNG = 8
    End Enum

    <DllImport("user32.dll", SetLastError:=True)> _
    Public Shared Function SendMessageTimeout(ByVal windowHandle As IntPtr, _
                                              ByVal Msg As Integer, _
                                              ByVal wParam As IntPtr, _
                                              ByVal lParam As IntPtr, _
                                              ByVal flags As SendMessageTimeoutFlags, _
                                              ByVal timeout As Integer, _
                                              ByRef result As IntPtr) As IntPtr
    End Function