Option Explicit
'****************************************************************************
' 機能名    : EXCEL通信テスト(TCP/IPサーバ)
' 機能説明  : EXCELを使用したTCP/IPの通信テストツール
' 著作権    : Copyright(C) 2010 のん All rights reserved
' 動作環境  : VB6の開発環境(特にMSWINSCK.OCX)
'****************************************************************************

' MSWINSCK.OCXを参照設定しています
Private WithEvents Winsock1 As MSWinsockLib.Winsock

' 受信データ表示行番号
Private InputRow As Long

' ソケット(TCPIP)接続およびクライアントからの接続待ち
Private Sub Btn_Open_Click()
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing = False Then
        MsgBox "既にソケット(TCPIP)が接続されています"
        Exit Sub
    End If
    
    ' 受信データ表示カラムをクリア
    Sheet1.Range("B15:B999") = ""

    ' 受信データ表示行番号初期化
    InputRow = 15
    
    ' ソケット(TCPIP)接続情報取得
    Dim lo As String: lo = Sheet1.Cells(5, 4)
    
    ' ソケット(TCPIP)接続およびクライアントからの接続待ち
    Set Winsock1 = New MSWinsockLib.Winsock
    Winsock1.Close
    Winsock1.LocalPort = lo
    Winsock1.Listen
End Sub

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

' クライアントからの接続
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    ' 複数クライアントとの接続を行なわない仕様
    Winsock1.Close
    ' クライアントからの接続を許可
    Winsock1.Accept requestID
End Sub

' クライアントからの切断
Private Sub Winsock1_Close()
    ' ソケット(TCPIP)接続情報取得
    Dim lo As String: lo = Sheet1.Cells(5, 4)
    
    ' ソケット(TCPIP)接続およびクライアントからの接続待ち
    Winsock1.Close
    Winsock1.LocalPort = lo
    Winsock1.Listen
End Sub

' ソケット(TCPIP)へデータ送信
Private Sub Btn_Send_Click()
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing Then
        MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    If Winsock1.State <> sckConnected Then
        MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    
    ' 選択したセルのデータを送信データとする
    Dim sdat As String
    If ActiveCell.Row >= 4 And ActiveCell.Column >= 2 And _
       ActiveCell.Row <= 13 And ActiveCell.Column <= 4 Then
        sdat = Sheet1.Cells(ActiveCell.Row, ActiveCell.Column)
    End If
    
    If sdat <> "" Then
        If Sheet1.Chk_SHex.Value = True Then
            ' 送信データをHEXコードから文字列に変換--ここから--
            On Error Resume Next
            Dim i As Long
            ReDim shex(Int((Len(sdat) + 1) / 2) - 1) As Byte
            For i = 0 To Len(sdat) - 1 Step 2
                shex(i / 2) = "&H" & Mid$(sdat, i + 1, 2)
            Next i
            On Error GoTo 0
            ' 送信データをHEXコードから文字列に変換--ここまで--
            
            ' ソケット(TCPIP)にデータ送信
            Winsock1.SendData shex
        Else
            ' ソケット(TCPIP)にデータ送信
            Winsock1.SendData sdat
        End If
    Else
        MsgBox "送信データ(セル)を選択してください。"
    End If
End Sub

' ソケット(TCPIP)からデータ受信
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    ' ソケット(TCPIP)接続チェック
    If Winsock1 Is Nothing Then
        'MsgBox "ソケット(TCPIP)が接続されていません"
        Exit Sub
    End If
    
    Dim rdat As String: rdat = ""
    If Sheet1.Chk_RHex.Value = True Then
        ' ソケット(TCPIP)からデータ受信
        Dim rhex() As Byte
        Winsock1.GetData rhex
        
        ' 受信データをHEXコードに変換--ここから----------------
        Dim i As Long
        For i = 0 To UBound(rhex)
            Dim str As String
            str = "00" & Hex(rhex(i))
            rdat = rdat & Right$(str, 2)
        Next i
        ' 受信データをHEXコードに変換--ここまで----------------
    Else
        ' ソケット(TCPIP)からデータ受信
        Winsock1.GetData rdat
    End If

    ' 受信データ表示セルに受信データを表示
    rdat = Replace$(rdat, Chr(0), "")
    Sheet1.Cells(InputRow, 2) = "" & rdat
    InputRow = InputRow + 1
End Sub

' 送信データ選択カラム変更
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Sheet1.Unprotect
    Sheet1.Range("B4:C13").Font.ColorIndex = 0
    If Target.Cells.Row >= 4 And Target.Cells.Row <= 13 And _
       Target.Cells.Column >= 2 And Target.Cells.Column <= 3 Then
        Target.Font.ColorIndex = 3
    End If
    Sheet1.Protect
End Sub