Hatena::ブログ(Diary)

いろいろ解析日記 このページをアンテナに追加 RSSフィード

2010-03-07

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

目次

概要

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メソッドの1番目から3番目の引数は入力値です。1番目に送信先のIPアドレス、2番目に送信先のポート番号、3番目にメッセージを指定します。

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

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

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

エクセルシート

f:id:nattou_curry_2:20100307231403j:image

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

なお、メッセージ送信ボタンに標準モジュールの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

参考

VBANewComerVBANewComer 2011/10/23 11:56 MSWINSCK.OCXをダウンロードしてきて試しに使ってみましたが
「ActiveXコンポーネントはオブジェクトを参照できません。」というエラー(エラーコード429)
が出てきてうまく動きません。どうすればいいのでしょうか。フリーのWinsockはないのでしょうか。

スパム対策のためのダミーです。もし見えても何も入力しないでください
ゲスト


画像認証

トラックバック - http://d.hatena.ne.jp/nattou_curry_2/20100307/1267971499
リンク元