----------------　フォーム(送受信)・モジュール ------------------
Option Compare Database

'****************************************************************************
' 機能名    : EXCEL通信テスト(TCP/IPサーバ)-(複数クライアント対応)-(Sheet1)
' 機能説明  : EXCELを使用したTCP/IPの通信テストツール
' 著作権    : Copyright(C) 2012 のん All rights reserved
' ＵＲＬ    : http://homepage2.nifty.com/nonnon/
'           : このソースを使用(流用/改変/転載/等全て)した成果物を不特定
'           : 多数に公開/配布する場合は、このソースを参考にした旨を記述
'           : してください。(例)WEBページやReadMeにURLのリンクを貼る等
' 動作環境  : MSWINSCK.OCXが入っているVB6ランタイムが必要です。
'           : 事前に"regsvr32 NONCOMSCK.OCX"を実行してください。
'****************************************************************************
' 2012/12/01 Modified by MEDiAQ
'****************************************************************************


' NONCOMSCK.OCXを参照設定しています
    Private WithEvents Winsock1 As NonComSck.Winsock
    Private Winsock2(9) As Class1


Private Sub Form_Open(Cancel As Integer)
    
    PrmInit
    Me.TxBx1 = ""
        

End Sub

Private Sub SocketOpen_Click()
    Dim i2 As Integer
    
    PrmInit
    
    ' サーバ(TCPIP)接続チェック
    If Winsock1 Is Nothing = False Then
        msgout "既にソケット(TCPIP)が接続されています"
        Exit Sub
    End If
    
    
    ' クライアント(TCPIP)からの接続待ち(サーバ)
    Set Winsock1 = CreateObject("NonComSck.Winsock")
    Winsock1.Close2
    Winsock1.LocalPort = loPort
    Winsock1.Listen

    ' クライアント用オブジェクト生成
    For i2 = 0 To UBound(Winsock2)
        Set Winsock2(i2) = New Class1
    Next i2
    msgout "全ソケットをオープンしました"

End Sub

Private Sub SocketClose_Click()
    
    ' ソケットクローズ
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing Then
        MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    
    ' サーバ(TCPIP)切断
    Winsock1.Close2
    Set Winsock1 = Nothing

    ' クライアント(TCPIP)切断
    Dim i2 As Integer
    For i2 = 0 To UBound(Winsock2)
        If Winsock2(i2).Client Is Nothing = False Then
            Winsock2(i2).Client.Close2
            Set Winsock2(i2).Client = Nothing
        End If
    Next i2
    
    msgout ("全ソケット切断しました")

End Sub


Private Sub dataTX_Click()
    ' ソケット送信
    Dim sdat, ss As String
    
    Me.TxBx2.SetFocus
    sdat = Me.TxBx2.Text

    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing Then
        MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If

    ' クライアントへデータ送信
    For i2 = 0 To UBound(Winsock2)
        If Winsock2(i2).Client Is Nothing = False Then
            Winsock2(i2).Client.SendData sdat
            ss = "(TxD)" & Winsock2(i2).Client.RemoteHostIP & "<" & sdat
            msgout ss
            DoEvents
            
        End If
    Next i2

End Sub


' クライアント(TCPIP)からの接続
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)

    ' クライアント(TCPIP)からの接続許可設定
    Dim idx As Integer: idx = -1
    Dim i2 As Integer
    Dim ss As String
    
    For i2 = 0 To UBound(Winsock2)
        If Winsock2(i2).Client Is Nothing Then
            idx = i2
        End If
        If idx >= 0 And idx <= UBound(Winsock2) Then
            Set Winsock2(idx).Client = Winsock1
            Winsock2(idx).Client.Close2
            Winsock2(idx).Client.Accept requestID
            ss = "接続:" & Winsock2(idx).Client.RemoteHostIP
            msgout ss
            Exit For
        End If
    Next i2
    
    ' クライアント(TCPIP)からの接続待ち(サーバ)
    Dim lo As String: loPort = 4000
    Set Winsock1 = CreateObject("NonComSck.Winsock")
    Winsock1.Close2
    Winsock1.LocalPort = loPort
    Winsock1.Listen
End Sub

----------------　標準モジュール(Module1) ------------------
Option Compare Database

Public loPort, InputRow As Long

Public Sub PrmInit()
    'パラメータの初期化ルーチン
    InputRow = 0
    loPort = 4000
End Sub

Public Sub msgout(st As String)

Dim ss As String

    'メッセージ出力ルーチン
    ss = Format(str(InputRow), "0000:") & st & vbCrLf
    Forms![送受信]!TxBx1 = Forms![送受信]!TxBx1.Value + ss
    InputRow = InputRow + 1

End Sub



----------------　クラス・モジュール(Class1) ------------------
Option Compare Database

'****************************************************************************
' 機能名    : EXCEL通信テスト(TCP/IPサーバ)-(複数クライアント対応)-(Class1)
' 機能説明  : EXCELを使用したTCP/IPの通信テストツール
' 著作権    : Copyright(C) 2012 のん All rights reserved
' ＵＲＬ    : http://homepage2.nifty.com/nonnon/
'           : このソースを使用(流用/改変/転載/等全て)した成果物を不特定
'           : 多数に公開/配布する場合は、このソースを参考にした旨を記述
'           : してください。(例)WEBページやReadMeにURLのリンクを貼る等
' 動作環境  : MSWINSCK.OCXが入っているVB6ランタイムが必要です。
'           : 事前に"regsvr32 NONCOMSCK.OCX"を実行してください。
'****************************************************************************
' 2012/12/01 Modified by MEDiAQ
'****************************************************************************

' NONCOMSCK.OCXを参照設定しています
Public WithEvents Client As NonComSck.Winsock


' クライアント(TCPIP)からの切断
Private Sub Client_Close2()
    Dim ss As String
    
    ' クライアント(TCPIP)切断
    Client.Close2
    ss = "切断：" & Client.RemoteHostIP
    msgout ss
    Set Client = Nothing
End Sub

' クライアント(TCPIP)からのデータ受信
Private Sub Client_DataArrival(ByVal bytesTotal As Long)
    Dim rdat, ss As String: rdat = ""
    
    ' クライアント(TCPIP)からデータ受信
    Client.GetData rdat

    ' 受信データ表示セルに受信データを表示
    rdat = Replace$(rdat, Chr(0), "")
    ss = "(RxD)" & Client.RemoteHostIP & ">" & rdat
    msgout ss
End Sub

----------------------------------------------