ウインドウメッセージによるプロセス間通信(WM_COPYDATA)

WM_COPYDATAメッセージを利用したプロセス間通信処理を作成する。

WM_COPYDATAはプロセス間通信を目的としたウインドウメッセージで任意のサイズのデータをグローバルヒープメモリを通して別プロセスに伝えることができる。使用に当たっては、以下の課題を整理した上で実装する必要がある。

・WM_COPYDATAという名前だがコピー処理自体は自前で行う必要がある。
・ウインドウメッセージで転送されるのはデータのポインタでデータ自体は転送されない。データはグローバルヒープメモリに保存する。
・メッセージを送信する前にMarshal.GlobalHAllocを使用してグローバルヒープメモリを確保する。転送が終わったらMarshal.FreeHGlobalで解放する。
・メモリの確保と解放のタイミングをコントロールするためにPostMessageで非同期処理することは出来ない。WM_COPYDATAはSendMessageでの使用がルール。
・SendMessageを使った同期処理なのでデータ受信側のウインドウがウインドウプロシージャで時間のかかる処理をすると送信側もブロックされる。
・受け取り側はプロセス内のメモリにグローバルヒープメモリを速やかにコピーして処理を返すのがマナー。コピー後は、ウインドウメッセージのリフティング処理を行って処理を遅延させる。
・PostMessageするまえにSendMessageが複数回実行される可能性があり、両方を処理する必要があるなら受信側はウインドウメッセージをキューで管理する必要がある。
・任意のサイズのデータを転送できる。
・送信先のウインドウハンドルを知るためにFindWindowExを使用してウインドウテキストから検索する。ウインドウテキストは通信したいプロセス間で一般的に使用されない文字列を取り決めておく。（GUIDなどがおすすめ）
・WindowsVistaではウインドウメッセージがフィルタリングされるので、ChangeWindowMessageFilterを使用してウインドウメッセージを受信できるよう設定する必要がある。
・ウインドウメッセージの処理のために、System.Windows.Forms.NativeWindowを継承する。
・クリップボードの処理などとは関係ない
・Windows Vista や Windows 2008 では適切に受け渡すデータをMarshal.GlobalHAllocなどで確保しておかないとメッセージ自体がフィルタリングされる場合がある。ChangeWindowMessageFilterの問題と誤解しやすいので注意。

上記を考慮した実装例

Public Class Form1
    Private _ipc As IPCUtils = Nothing
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim a As New IPCUtils.TransferMessage
        a.MessageType = IPCUtils.MessageType.TextMessage

        a.Message = "Hello"

        a.ItemData = Now
        _ipc.SendMessage(a)
    End Sub
    Public Sub OnReceiveMessage(ByVal item As IPCUtils.TransferMessage)
        MsgBox(item.Message)
    End Sub


    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        IPCUtils.ChangeMessageFileter()
        _ipc = New IPCUtils("{662BA774-2658-4439-9CFE-AFE58CDBCC40}")
        AddHandler _ipc.ReceiveMessage, AddressOf Me.OnReceiveMessage
    End Sub
End Class

Imports System.Windows.Forms

Imports System.Runtime.InteropServices

Imports System.Runtime.Serialization.Formatters.Binary
Public Class IPCUtils

    Inherits System.Windows.Forms.NativeWindow
    Public Enum MessageType

        TextMessage

    End Enum
     _

    Public Class TransferMessage

        Public MessageType As MessageType = IPCUtils.MessageType.TextMessage

        Public Message As String = String.Empty

        Public ItemData As Object = Nothing

    End Class
    Public Event ReceiveMessage(ByVal item As TransferMessage)
    Public CommunicationName As String = CS_DEFAULT_IPC_NAME
    Private Const CS_DEFAULT_IPC_NAME As String = "{4F5E5E74-7405-4809-BF67-581842E65D14}"
     _

    Private Shared Function FindWindowEx(ByVal parentHandle As IntPtr, _

                                         ByVal childAfter As IntPtr, _

                                         ByVal lclassName As String, _

                                         ByVal windowTitle As String) As IntPtr

    End Function
     _

    Private Shared Function SendMessage(ByVal hWnd As IntPtr, _

                                        ByVal Msg As UInteger, _

                                        ByVal wParam As IntPtr, _

                                        ByVal lParam As IntPtr) As IntPtr

    End Function
     _

    Private Shared Function PostMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Boolean

    End Function
    Private Const WM_USER As UInteger = &H400

    Private Const WM_IPC_MESSAGE As UInteger = WM_USER + 1

    Private Const WM_COPYDATA As UInteger = &H4A
    Private Const WS_BORDER As Int32 = &H800000
    Private Structure COPYDATASTRUCT

        Public dwData As IntPtr

        Public cbData As Int32

        Public lpData As IntPtr

    End Structure
    Private _messageQueue As Queue(Of TransferMessage)

    Private _isCreatedWindow As Boolean = False
    Private Delegate Function ChangeWindowMessageFilter(ByVal message As UInteger, ByVal dwflag As Int32) As Boolean

    Private Const MSGFLT_ADD As Integer = 1

    Private Const MSGFLT_REMOVE As Integer = 2
    Public Sub New(ByVal communicationName As String)
        MyBase.New()
        _messageQueue = New Queue(Of TransferMessage)

        Me.CommunicationName = communicationName
        Me.CreateMessageOnlyWindow()
    End Sub
    Public Shared Sub ChangeMessageFileter()
        Dim loader As New DynamicLibraryLoader

        Dim result As Boolean = loader.Load("user32.dll")

        If result = True Then

            Try

                Dim procPtr As [Delegate] = loader.GetDelegate("ChangeWindowMessageFilter", GetType(ChangeWindowMessageFilter))

                If Not procPtr Is Nothing Then
                    Dim funcPtr As ChangeWindowMessageFilter = CType(procPtr, ChangeWindowMessageFilter)

                    Dim funcResult As Boolean = False
                    funcResult = funcPtr(WM_COPYDATA, MSGFLT_ADD)

                    funcResult = funcPtr(WM_IPC_MESSAGE, MSGFLT_ADD)
                End If
            Finally

                loader.Free()

            End Try

        End If
    End Sub
    Protected Overrides Sub Finalize()

        Me.DestroyMessageOnlyWindow()

        MyBase.Finalize()

    End Sub
    Private Sub CreateMessageOnlyWindow()
        Dim cp As New CreateParams
        cp.Caption = Me.CommunicationName
        cp.X = 0

        cp.Y = 0

        cp.Height = 0

        cp.Width = 0
        cp.Style = WS_BORDER
        Me.CreateHandle(cp)
        _isCreatedWindow = True
    End Sub
    Private Sub DestroyMessageOnlyWindow()
        If _isCreatedWindow = True Then

            Me.DestroyHandle()

            _isCreatedWindow = False

        End If
    End Sub
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        Select Case m.Msg

            Case WM_COPYDATA
                Dim data As Object = Marshal.PtrToStructure(m.LParam, GetType(COPYDATASTRUCT))

                Dim copyData As COPYDATASTRUCT = CType(data, COPYDATASTRUCT)
                Dim bytes(copyData.cbData) As Byte

                Marshal.Copy(copyData.lpData, bytes, 0, copyData.cbData)
                Dim mem As New System.IO.MemoryStream()
                Try
                    mem.Position = 0

                    mem.Write(bytes, 0, copyData.cbData)
                    Dim b As New BinaryFormatter
                    mem.Position = 0
                    Dim item As TransferMessage = Nothing

                    item = CType(b.Deserialize(mem), TransferMessage)

                    _messageQueue.Enqueue(item)
                    PostMessage(Me.Handle, WM_IPC_MESSAGE, IntPtr.Zero, IntPtr.Zero)
                Finally
                    mem.Close()
                End Try
            Case WM_IPC_MESSAGE
                If _messageQueue.Count > 0 Then
                    Dim item As TransferMessage = Nothing

                    item = _messageQueue.Dequeue
                    RaiseEvent ReceiveMessage(item)
                Else
                    RaiseEvent ReceiveMessage(Nothing)
                End If
        End Select
        MyBase.WndProc(m)
    End Sub
    Public Sub SendMessage(ByVal item As TransferMessage)
        Dim mem As New System.IO.MemoryStream()

        Dim bytes() As Byte
        Try
            Dim b As New BinaryFormatter

            b.Serialize(mem, item)
            bytes = mem.ToArray
        Finally
            mem.Close()
        End Try
        Dim ptr As IntPtr = Marshal.AllocHGlobal(bytes.Length)
        Try
            Marshal.Copy(bytes, 0, ptr, bytes.Length)
            Dim copyData As COPYDATASTRUCT

            copyData.dwData = IntPtr.Zero

            copyData.cbData = CType(bytes.Length, Int32)

            copyData.lpData = ptr
            Dim copyDataPtr As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(copyData))

            Marshal.StructureToPtr(copyData, copyDataPtr, False)
            Try
                Dim destHandle As IntPtr = IntPtr.Zero

                destHandle = FindWindowEx(IntPtr.Zero, IntPtr.Zero, vbNullString, Me.CommunicationName)
                Do While destHandle <> IntPtr.Zero
                    Dim messageResult As IntPtr = IntPtr.Zero
                    If destHandle <> Me.Handle Then
                        messageResult = SendMessage(destHandle, WM_COPYDATA, Me.Handle, copyDataPtr)
                    End If
                    destHandle = FindWindowEx(IntPtr.Zero, destHandle, vbNullString, Me.CommunicationName)
                Loop
            Finally

                Marshal.FreeHGlobal(copyDataPtr)

            End Try
        Finally
            Marshal.FreeHGlobal(ptr)
        End Try
    End Sub
End Class