アプリケーション間で文字列を送信する

● アプリケーション間で文字列を送信する ●

※※※ 2006/6/24 追記ここから ※※※
当時(と言ってもつい最近だが…)、このページは数箇所からリンクが張られ、WM_COPYDATA がらみの実装方法に関して VB っぽくないことをやっているせいか、何かと物議を醸していたようだ。まあ動作確認は Windows 95 で取っただけなので最近の OS では動かなくてもしょうがないのかにゃ～と適当に傍観していたが、今回全ページに手を入れるにあたり、このページのロジックは確認しておいた方がいいんじゃないの、と思ったので実際にやってみた。

修正した箇所は１つで、EnumWindowsMain() 内の EnumWindows API関数の第２引数に ByVal を付けただけ。あとはそのままコピペし、コンパイルして動作を確認したら、…正しく動いた。OS は Windows XP で確認したので問題は無かろう。ついでにそのソースと実行ファイルをここに置いておく。適当に試してみてください。→ Download
※※※ 2006/6/24 追記ここまで ※※※

２重起動を禁止しているアプリケーションの実行ファイルにファイルがドラッグされた。だけど、そのアプリケーションは既にファイルを読み込んでいるので、ファイルを読み込むどころか起動直後に２重起動を促すメッセージボックスが表示されアプリケーション終了。これでは悲しいよね。

そのような場合、起動処理は次のようになっているはず。

      If App.PrevInstance Then
          Call MsgBox("２重起動はできません", vbOKOnly + vbExclamation, App.Title)
          End
      End If

上のような２重起動禁止処理はちょっともの悲しい。ドラッグされたファイルパスを既に起動しているアプリケーションに送り込み、受け取った側はそのファイルを読み込む、また場合によってはエラーメッセージを表示する、としたいよね。ではどうするか。答えは簡単で、SendMessage API 関数を使用すればよろしい。

第２引数のメッセージには WM_COPYDATA を指定する。文字列送信側は第４引数に COPYDATASTRUCT構造体を指定する。COPYDATASTRUCT のメンバには送る文字列へのポインタとその文字列のサイズを指定するだけ。一方、文字列受信側はサブクラス化をすることで、文字列送信側からのメッセージを受け取る。第２引数のメッセージが WM_COPYDATA のとき、lParam には受信した文字列へのポインタが送られてくる。

さて、この両者をコーディングにより実現させるわけではあるが、コード量が少々多くなってしまう。まぁ我慢してね。とりあえず、API関数・定数・外部変数の宣言、汎用関数を先に書こう。

' ---------- 標準モジュール ----------
Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type

'サブクラス化関数
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private 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

Private Declare Sub CopyMemory Lib "Kernel32" Alias"RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'任意のメッセージを送信する
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'文字列のバイト数を取得する
Private Declare Function lstrlen Lib "Kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long

'画面上の全てのトップレベルウインドウを列挙する
Private Declare Function EnumWindows Lib "user32.dll" (ByVal ipEnumFunc As Long, lParam As Long) As Long

'指定したウインドウのタイトルバーテキストを取得
Private Declare Function GetWindowText Lib "user32" Alias"GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

'親ウインドウのハンドルを取得する
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long

'ウインドウのクラスの名前を取得する
Private Declare Function GetClassName Lib "user32" Alias"GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Const GWL_WNDPROC = (-4)  'ウインドウプロシージャ
Private Const WM_COPYDATA = &H4A

Private Const APPTITLE As String = "アプリケーション間で文字列の送信"

'デフォルトのウインドウプロシージャ
Public OldWindowhWnd As Long

Sub Main()

    If App.PrevInstance Then
        '既に起動しているウインドウを取得し取得したコマンドラインを送り込む
        Call EnumWindowsMain
        End
    End If

    'サブクラス化開始
    Call SubClass(frmMain.hWnd)

    With frmMain
        .Caption = APPTITLE
        .Show
    End With

End Sub

'----------------------------------------------------------------
' 関数名： EnumWindowsMain
' 機能  ： OS上に存在するウインドウを検列挙する
' 引数  ： なし
' 戻り値： なし
'----------------------------------------------------------------
Public Sub EnumWindowsMain()

    Call EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)

End Sub

'----------------------------------------------------------------
' 関数名： EnumWindowsProc
' 機能  ： OS上に存在するウインドウを検索し、既に起動している
'          ウインドウのハンドルを取得する
' 引数  ： (in) hWnd … 存在するウインドウのハンドル
'          (in) lParam …  常に０が送られる
' 戻り値： エラー：０  正常：０以外
' 備考  ： 検索方法はウインドウのタイトルバーを見る
'----------------------------------------------------------------
Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long

    Dim ret As Long

    Dim tmpBuff As String * 256
    Dim WndText As String

    If GetParent(hWnd) = 0 Then
        'ウインドウのキャプションを取得
        ret = GetWindowText(hWnd, tmpBuff, Len(tmpBuff))

        'NULLを削除
        WndText = strNullCut(tmpBuff)

        '発見!!
        If Left$(WndText, Len(APPTITLE)) = APPTITLE Then

            '今度はクラス名を比較
            'Sub Mainしかとおっていないとクラス名は ThunderRT5Main
            'となっている。これではまずい。
            '
            '注意)ThunderRT5Main はVisual Basic のバージョンによって違う
            '
            If UCase$(GetVBClassName(hWnd)) = UCase$("ThunderRT5Form") Then
                'コールバック関数で指定したウインドウに文字列を送る
                Call SendStringToForm(hWnd, Command$ & Chr$(0))

                '検索終了
                EnumWindowsProc = False
                Exit Function
            End If
        End If

    End If

    '検索継続
    EnumWindowsProc = True

End Function

'---------------------------------------------------------------------------
'  関数名： SubClass
'   機能 ： サブクラス化を開始する
'   引数 ： (in) hWnd … 対象フォームのウインドウハンドル
'  返り値 ： なし
'---------------------------------------------------------------------------
Public Sub SubClass(ByVal hWnd As Long)

    OldWindowhWnd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)

End Sub


'---------------------------------------------------------------------------
'  関数名： SubClass
'   機能 ： サブクラス化を終了する
'   引数 ： (in) hWnd … 対象フォームのウインドウハンドル
'  返り値 ： なし
'---------------------------------------------------------------------------
Public Sub UnSubClass(ByVal hWnd As Long)

    Dim ret As Long

    If OldWindowhWnd <> 0 Then
        '元のプロシージャアドレスに設定する
        ret = SetWindowLong(hWnd, GWL_WNDPROC, OldWindowhWnd)

        OldWindowhWnd = 0&
    End If

End Sub

'---------------------------------------------------------------------------
'  関数名 ： GetVBClassName
'  機能   ： ウインドウハンドルよりクラス名を取得する
'  引数   ： (in) hWnd … ウインドウハンドル
'  返り値 ： クラス名
'---------------------------------------------------------------------------
Public Function GetVBClassName(ByVal hWnd As Long) As String

    Dim ret As Long
    Dim strBuffer As String * 256

    ret = GetClassName(hWnd, strBuffer, Len(strBuffer))

    GetVBClassName = IIf(ret = 0, "", strNullCut(strBuffer))

End Function

'---------------------------------------------------------------
'  関数名： strNullCut
'   機能 ： 文字列を vbNullChar までを取得する
'   引数 ： (in) srcStr … 対象文字列
'  返り値 ：編集された文字列
'---------------------------------------------------------------
Public Function strNullCut(ByVal srcStr As String) As String

    Dim NullCharPos As Integer

    NullCharPos = InStr(srcStr, Chr$(0))

    If NullCharPos = 0 Then
        strNullCut = srcStr
        Exit Function
    End If

    strNullCut = Left$(srcStr, NullCharPos - 1)

End Function

それでは文字列を送信するコードを書きましょう。COPYDATASTRUCT のメンバには文字列のポインタを指定すればいいのだけれど、Unicode から ANSI に文字列を変換してあげなければいけないみたい。下の関数は EnumWindowsProc から呼び出される。

'-----------------------------------------------------------------------
' 関数名 ： SendStringToForm
' 機能   ： 指定したウインドウに文字列を送る
' 引数   ： (in) hWnd     … 指定したウインドウのハンドル
'           (in) SendString … 送る文字列
' 戻り値 ： なし
'-----------------------------------------------------------------------
Public Sub SendStringToForm(ByVal hWnd As Long, ByVal SendString As String)

    Dim ret As Long
    Dim udtCDP As COPYDATASTRUCT
    Dim StrBuff As String

    SendString = SendString & Chr$(0)
    StrBuff = StrConv(SendString, vbFromUnicode)

    With udtCDP
        .dwData = 0
        .cbData = LenB(StrBuff) + 1
        .lpData = StrPtr(StrBuff)
    End With

    Call SendMessage(hWnd, WM_COPYDATA, 0&, udtCDP)

End Sub

次は受信する側のコード。文字列取得方法は取得した文字列へのポインタより NULL までの長さを取得し、その長さ分バイト単位でコピーしてやればよい。

'------------------------------------------------------------------------- ' 関数名： WindowProc ' 機能：ウインドウメッセージをフックする ' 引数： (in) hWnd … 対象フォームのウインドウハンドル ' (in) uMsg … ウインドウメッセージ ' (in) wParam … 追加情報１ ' (in) lParam … 追加情報２ ' 返り値：なし ' 備考：特になし '--------------------------------------------------------------------------- Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Dim udtCDP As COPYDATASTRUCT Dim SentText As String '送られてきた文字列 Dim SentTextLen As Long '送られてきた文字列の数 Select Case uMsg Case WM_COPYDATA '外部からメッセージを受け取った Call CopyMemory(udtCDP, ByVal lParam, Len(udtCDP)) '受け取った文字列の数 SentTextLen = udtCDP.cbData '初期化する SentText = String$(SentTextLen, Chr$(0)) '待望の文字列取得 Call CopyMemory(ByVal SentText, ByVal udtCDP.lpData, SentTextLen) 'NULL削除 SentText = strNullCut(SentText) frmMain.Label1 = SentText End Select WindowProc = CallWindowProc(OldWindowhWnd, hWnd, uMsg, wParam, lParam)

End Function

標準モジュールに書く内容は以上である。あとはフォームモジュール(オブジェクト名：frmMain)にラベルを１つ(オブジェクト名：Label1)貼り付け、そして Form_QueryUnload イベントに次のコードを書けばよい。

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Call UnSubClass(frmMain.hWnd)
End Sub

最後にスタートアップの設定を Sub Main にして、コンパイルしよう。そうしたら速攻で起動。その一方で実行ファイルにファイルをドラッグ＆ドロップすると、起動済みのウィンドウに実行ファイルに渡されたファイルのパスが表示される。もうこれで２重起動は強制終了という虚しい処理とはおさらばだ！

戻る