いろいろ解析日記

Excel VBAでメッセージ送信を行うWinsockクライアント「clsWinsockClient」

VBA, ネットワーク

目次

• 概要
• 事前準備
• 使い方
• ソースコード
• サンプル
• 参考

概要

Excel VBAでメッセージ送信を行うWinsockクライアント「clsWinsockClient」を作成しました。

clsWinsockClientを利用すると、別途作成したWinsockサーバ「clsWinsockServer」に対してメッセージを送信できます。

事前準備

本クライアントを使用するには、以下の手順で「Microsoft Winsock Control 6.0」への参照設定を追加する必要があります。

1. Visual Basic Editorの「ツール」メニューから「参照設定」ダイアログを開きます。
2. 参照設定ダイアログ上の「参照」ボタンを押し、「ファイルの参照」ダイアログを開きます。
3. ファイルの参照ダイアログで「c:\Windows\system32\MSWINSCK.OCX」を選択し、「開く」ボタンを押します。
4. 参照可能なライブラリファイルに「Microsoft Winsock Control 6.0」が追加されたことを確認し、「OK」ボタンを押します。

使い方

clsWinsockClientをクラスモジュールとしてプロジェクトに追加し、標準モジュール等から以下のように利用します。

    '// 1. Winsockクライアントを生成する。
    Set wkClient = New clsWinsockClient
    
    '// 2. メッセージを送信する。
    If wkClient.SendMessage("192.168.1.20", 1500, "Test Message", wkDescription) = 9 Then
        '// エラー時の処理:
        Call MsgBox("ﾒｯｾｰｼﾞ送信に失敗しました。(" & wkDescription & ")", vbCritical)
        Exit Sub
    End If
    
   Call MsgBox("ﾒｯｾｰｼﾞ送信に成功しました。", vbInformation)
    

1. Winsockクライアントを生成する。

まず最初に、Newを使ってclsWinsockClientのインスタンスを生成します。

2. メッセージを送信する。

メッセージを送信するには、clsWinsockClientのインスタンスのSendMessageメソッドを呼び出します。

SendMessageメソッドの１番目から３番目の引数は入力値です。１番目に送信先のIPアドレス、２番目に送信先のポート番号、３番目にメッセージを指定します。

上記の例の場合、IPアドレス「192.168.1.20」のポート番号「1500」に対してメッセージ「Test Message」を送信します。

４番目の引数は出力値で、メッセージ送信結果の詳細が格納されます。そのため、４番目の引数には変数を指定する必要があります。

SendMessageメソッドの戻り値はメッセージ送信の成功・失敗を表します。成功した場合には「0」が、失敗した場合には「9」が返却されます。

ソースコード

以下、clsWinsockClientのソースコードです。

clsWinsockClientクラスモジュール

Option Explicit

Private WithEvents mdl_winsock_client As Winsock    '// ｿｹｯﾄ

Private mdl_arrived_data As String                  '// 受信ﾃﾞｰﾀ

'//////////////////////////////////////////////////////
' ｸﾗｽ初期化時の処理
'//////////////////////////////////////////////////////
Private Sub Class_Initialize()

    '// ｿｹｯﾄを生成する。
    Set mdl_winsock_client = New Winsock
    
End Sub

'//////////////////////////////////////////////////////
' SendMessage
' 概要  : ﾒｯｾｰｼﾞを送信する。
' 引数  : IN :(String)    i_remote_host 接続先ﾎｽﾄ
'         IN :(Intger)    i_remote_port 接続先ﾎﾟｰﾄ番号
'         IN :(String)    i_message     ﾒｯｾｰｼﾞ
'         OUT:(String)    o_description 送信結果の詳細
' 戻り値: 正常時: 0、ｴﾗｰ時: 9
'//////////////////////////////////////////////////////
Public Function SendMessage(i_remote_host As String, i_remote_port As Integer, i_message As String, o_description As String) As Integer
        
        Dim wkEndTime As Date                       '// ﾀｲﾑｱｳﾄ時刻
        Dim wkResult As Integer                     '// 処理結果(-1: ﾀｲﾑｱｳﾄ、0: 成功、1: ｴﾗｰ)
        
On Error GoTo ERR_PROC

    SendMessage = 9
     
    '//////////////////////////////////////////////////////
    ' ｿｹｯﾄの接続先を設定する。
    '//////////////////////////////////////////////////////
    
    '// 接続先のIPｱﾄﾞﾚｽを設定する。
    mdl_winsock_client.RemoteHost = i_remote_host
    '// 接続先のﾎﾟｰﾄ番号を設定する。
    mdl_winsock_client.RemotePort = i_remote_port
    
    '//////////////////////////////////////////////////////
    ' ｿｹｯﾄの接続要求を行う。
    '//////////////////////////////////////////////////////
    
    '// ｿｹｯﾄの接続要求を行う。
    Debug.Print "ｿｹｯﾄの接続要求を行います。"
    Call mdl_winsock_client.Connect
    
    '//////////////////////////////////////////////////////
    ' 接続が完了したことを確認する。
    '//////////////////////////////////////////////////////
    
    '// 処理結果をﾀｲﾑｱｳﾄに初期化する。
    wkResult = -1
    
    '// 接続が完了したことを確認する。
    '// ただし、一定時間経過しても接続が完了しない場合はﾀｲﾑｱｳﾄとする。
    wkEndTime = Now() + TimeValue("00:00:03")
    Do While Now() < wkEndTime
        
        '// OSに制御を移し、接続処理を実行させる。
        DoEvents
    
        If mdl_winsock_client.State = sckConnected Then
            '// 接続完了:
            
            '// 処理結果を成功にする。
            wkResult = 0
            Exit Do
        End If
    
        If mdl_winsock_client.State = sckError Then
            '// 接続ｴﾗｰ:
            
            '// 処理結果をｴﾗｰにする。
            wkResult = 1
            Exit Do
        End If
    Loop
    
    If wkResult = -1 Then
        '// ﾀｲﾑｱｳﾄ:
        Debug.Print "接続要求でﾀｲﾑｱｳﾄしました。"
        o_description = "接続要求でﾀｲﾑｱｳﾄしました。"
        GoTo END_PROC
    End If
    
    If wkResult = 1 Then
        '// ｴﾗｰ:
        Debug.Print "接続要求でｴﾗｰが発生しました。"
        o_description = "接続要求でｴﾗｰが発生しました。"
        GoTo END_PROC
    End If
    
    Debug.Print "接続要求に成功しました。"
    
    '//////////////////////////////////////////////////////
    ' ﾒｯｾｰｼﾞを送信する。
    '//////////////////////////////////////////////////////
    
    '// ｻｰﾊﾞからの返信をﾘｾｯﾄする。
    mdl_arrived_data = ""
    
    '// ﾒｯｾｰｼﾞを送信する。
    Debug.Print "ﾒｯｾｰｼﾞを送信します。"
    Call mdl_winsock_client.SendData(i_message)
    
    '//////////////////////////////////////////////////////
    ' ﾒｯｾｰｼﾞ送信の結果を確認する。
    '//////////////////////////////////////////////////////
    
    '// 処理結果をﾀｲﾑｱｳﾄに初期化する。
    wkResult = -1
    
    wkEndTime = Now() + TimeValue("00:00:03")
    Do While Now() < wkEndTime
        
        '// OSに制御を移し、送信処理を実行させる。
        DoEvents
    
        If mdl_arrived_data <> "" Then
            '// ｻｰﾊﾞからの返信を受信:
            
            '// 処理結果を成功にする。
            wkResult = 0
            Exit Do
        End If
    
        If mdl_winsock_client.State = sckClosing Then
            '// ﾒｯｾｰｼﾞ送信中に接続先がｸﾛｰｽﾞ:
            
            '// 処理結果をｴﾗｰにする。
            wkResult = 1
            Exit Do
        End If
        
    Loop
    
    If wkResult = -1 Then
        '// ﾀｲﾑｱｳﾄ:
        Debug.Print "ﾒｯｾｰｼﾞ送信でﾀｲﾑｱｳﾄしました。"
        o_description = "ﾒｯｾｰｼﾞ送信でﾀｲﾑｱｳﾄしました。"
        GoTo END_PROC
    End If
    
    If wkResult = 1 Then
        '// ｴﾗｰ:
        Debug.Print "ﾒｯｾｰｼﾞ送信に失敗しました。"
        o_description = "ﾒｯｾｰｼﾞ送信に失敗しました。"
        GoTo END_PROC
    End If
    
    Debug.Print "ﾒｯｾｰｼﾞ送信に成功しました。"
    o_description = "ﾒｯｾｰｼﾞ送信に成功しました。"

    SendMessage = 1

    GoTo END_PROC
        
ERR_PROC:

    o_description = Err.Description
    Debug.Print Err.Description

END_PROC:
            
    '//////////////////////////////////////////////////////
    ' ｿｹｯﾄを切断する。
    '//////////////////////////////////////////////////////
    
    Debug.Print "ｿｹｯﾄをｸﾛｰｽﾞします。"
    Call mdl_winsock_client.Close
    
    '// OSに制御を移し、ｸﾛｰｽﾞ処理を実行させる。
    DoEvents
        
End Function

'//////////////////////////////////////////////////////
' 接続先からﾃﾞｰﾀを受信した時の処理
'//////////////////////////////////////////////////////
Private Sub mdl_winsock_client_DataArrival(ByVal bytesTotal As Long)

    '// ｻｰﾊﾞから受信したﾃﾞｰﾀを取得し、受信ﾃﾞｰﾀ用変数に格納します。
    Call mdl_winsock_client.GetData(mdl_arrived_data)
    
End Sub

'//////////////////////////////////////////////////////
' 接続先からｿｹｯﾄをｸﾛｰｽﾞされた時の処理
'//////////////////////////////////////////////////////
Private Sub mdl_winsock_client_Close()

    '// ｿｹｯﾄをｸﾛｰｽﾞする。
    Debug.Print "接続先からｿｹｯﾄをｸﾛｰｽﾞされたため、ｿｹｯﾄをｸﾛｰｽﾞします。"
    Call mdl_winsock_client.Close

    '// OSに制御を移し、ｸﾛｰｽﾞ処理を実行させる。
    DoEvents

End Sub

'//////////////////////////////////////////////////////
' ｿｹｯﾄ通信中にｴﾗｰが発生した時の処理
'//////////////////////////////////////////////////////
Private Sub mdl_winsock_client_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    
    '// ｿｹｯﾄをｸﾛｰｽﾞする。
    Debug.Print "ｿｹｯﾄ通信中にｴﾗｰが発生したため、ｿｹｯﾄをｸﾛｰｽﾞします。"
    Call mdl_winsock_client.Close

    '// OSに制御を移し、ｸﾛｰｽﾞ処理を実行させる。
    DoEvents

End Sub

サンプル

clsWinsockClientを使用するサンプルを作成しました。このサンプルはエクセルシートと標準モジュールで構成されています。

エクセルシート

接続先ホスト名、接続先ポート番号、メッセージを入力してメッセージ送信ボタンを押すと、メッセージを送信できます。

なお、メッセージ送信ボタンに標準モジュールのSendMessage関数を関連付けています。

標準モジュール

Option Explicit

'//////////////////////////////////////////////////////
' ﾒｯｾｰｼﾞを送信する。
'//////////////////////////////////////////////////////
Public Sub SendMessage()

    Dim wkSheet As Worksheet                    '// ｼｰﾄ(Winsockｸﾗｲｱﾝﾄﾌﾟﾛｸﾞﾗﾑ)
    
    Dim wkHostName As String                    '// 接続先ﾎｽﾄ名
    Dim wkPort As Integer                       '// 接続先ﾎﾟｰﾄ番号
    Dim wkMessage As String                     '// ﾒｯｾｰｼﾞ
    
    Dim wkClient As clsWinsockClient            '// Winsockｸﾗｲｱﾝﾄ
    
    Dim wkDescription As String                 '// ﾒｯｾｰｼﾞ送信結果の詳細
    
    '// ｼｰﾄを取得する。
    Set wkSheet = ThisWorkbook.Sheets("Winsockｸﾗｲｱﾝﾄﾌﾟﾛｸﾞﾗﾑ")
    
    '// 接続先ﾎｽﾄ名を取得する。
    wkHostName = wkSheet.Cells(4, 4)
    '// 接続先ﾎﾟｰﾄ番号を取得する。
    wkPort = wkSheet.Cells(6, 4)
    '// ﾒｯｾｰｼﾞを取得する。
    wkMessage = wkSheet.Cells(8, 4)
    
    '// Winsockｸﾗｲｱﾝﾄを生成する。
    Set wkClient = New clsWinsockClient
    
    '// ﾒｯｾｰｼﾞを送信する。
    If wkClient.SendMessage(wkHostName, wkPort, wkMessage, wkDescription) = 9 Then
        '// ｴﾗｰ:
        Call MsgBox("ﾒｯｾｰｼﾞ送信に失敗しました。(" & wkDescription & ")", vbCritical)
        Exit Sub
    End If
    
    Call MsgBox("ﾒｯｾｰｼﾞ送信に成功しました。", vbInformation)
 
End Sub

参考

• Excel VBAでメッセージ受信を行うWinsockサーバ「clsWinsockServer」

Permalink | コメント(1) | トラックバック(0) | 23:18