Option Explicit

'CGIファイルへのアドレスは記載しません
'自分でCGIサーバーをお探し下さい
'CGIスクリプトのバーミッションは755です。
Private Const CGI_URL = "http://---.---.---/---/cgi-bin/com.cgi"

'ループ時に閉じるボタンなどを押したときに
'ループから脱出するフラグです
Dim m_Quit As Boolean

'送信ボタンでデータの送信をします
Private Sub Command1_Click()
    If Winsock1.State = sckConnected Then
        List1.AddItem "ユーザー > " & Text1.Text
        Winsock1.SendData Text1.Text
        Text1.Text = ""
    End If
End Sub

'フォームをロードします
Private Sub Form_Load()
    '強制的にフォームを先に処理(表示)します
    Me.Show
    DoEvents
    
    'Winsockサーバーで後の処理のHTTPでアクセスした
    'CGIスクリプトからのアクセスを待ちます
    With Winsock1
        .Close
        List_Add List1, "システム > CGIからの接続を待機中..."
        .LocalPort = 1000
        .Listen
    End With
    
    'HTTPプロトコルでCGIファイルにアクセスします
    With sockHttp
        Dim var As Variant
        Dim strHost As String
        Dim strSubAddress As String
        
        'アドレスの表記を整えます
        var = Split(CGI_URL, "http://", 2)
        var = Split(var(1), "/", 2)
        strHost = var(0)
        strSubAddress = var(1)
        
        'HTTPプロトコルでサーバーに接続します
        .Close
        .Connect strHost, 80
        Do
            DoEvents
        Loop Until .State = sckConnected Or .State = sckError Or m_Quit
        If .State = sckError Then
            MsgBox "接続できませんでした", vbExclamation
            Exit Sub
        End If
        'CGIを立ち上げます
        .SendData "GET /" & strSubAddress & " HTTP/1.0" & vbCrLf & vbCrLf
    End With
    
End Sub

'フォームをアンロードします
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = 0 Then
        m_Quit = True
    End If
End Sub

'エラーが発生したときにメッセージボックスで表示します
Private Sub sockHttp_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)
    CancelDisplay = False
End Sub

'相手が接続を切りました
Private Sub Winsock1_Close()
    '接続を復帰します
    Form_Load
End Sub

'CGIスクリプトから接続されました
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    If Not (Winsock1.State = sckClosed) Then
        Winsock1.Close
    End If
    Winsock1.Accept requestID
    List_Add List1, "システム > 接続が確立しました"
End Sub

'CGIスクリプトからデータを受信しました
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim n As String
    Dim x As Variant
    Dim var As Variant
    
    '受信したデータの出力をします
    Winsock1.GetData n
    var = Split(n, vbLf)
    For Each x In var
        List_Add List1, "サーバー > " & x
    Next
End Sub

'エラーが発生したときにメッセージボックスで表示します
Private Sub Winsock1_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)
    Winsock1_Close
End Sub

'リストに文字列を追加しながらオートスクロールします
Sub List_Add(ByRef objList As ListBox, ByVal strMsg As String)
    objList.AddItem strMsg
    objList.ListIndex = objList.ListCount - 1
End Sub