Option Explicit

'CreateObjectを使って
'ロードしたオブジェクトを格納する変数です
Dim m_ActiveX As Object

Private Sub Form_Load()
    On Error GoTo ErrProcess
    
    '強制的にフォームを表示します
    Me.Show
    Me.Refresh
    
    'OCXをロードして生成します
    Set m_ActiveX = CreateObject("MSWinsock.Winsock.1")
    
    'HTTPポートでyahooに接続します
    m_ActiveX.Connect "www.yahoo.com", 80
    
    Dim nTime       As Long
    Dim xTime       As Long
    Dim flag        As Boolean
    
    '処理ループに入ります
    Do
        DoEvents
        '一秒おきに処理を実行します
        nTime = Second(Time)
        If Not (xTime = nTime) Then
            xTime = nTime
            'Winsockのステータスにより
            '処理を振り分けます
            Select Case m_ActiveX.state
                Case 0 '既に接続が切断されています
                    Debug.Print "# Closed"
                    
                Case 7 '既に接続が確立しています
                    Debug.Print "# Connected"
                    If flag = False Then
                        '一度だけ命令を送信します
                        flag = True
                        m_ActiveX.SendData "GET /index.html HTTP/1.0" & vbCrLf & vbCrLf
                    Else
                        'データを受信します
                        Recv m_ActiveX
                    End If
                    
                Case 8 '相手側が切断しています
                    Debug.Print "# Remote Closed"
                    'こちらも接続を閉じます
                    m_ActiveX.Close
                    
                Case 9 'エラーが発生しました
                    Debug.Print "# Error"
                    Info "Error!"
                    '処理を終了します
                    Exit Do
            End Select
            'Winsockの状態を表示します
            Debug.Print "[" & Now & "] > State = " & m_ActiveX.state & vbCrLf
        End If
        'State=0になるまでループします
    Loop Until m_ActiveX.state = 0
    Debug.Print "# end"
    Exit Sub
    
ErrProcess:
    MsgBox Err.Description, vbCritical
End Sub

'データを受信します
Sub Recv(objWinsock As Object)
    Dim strData As String
    
    If Not (objWinsock.BytesReceived = 0) And objWinsock.state = 7 Then
        objWinsock.GetData strData
        strData = MyReplace(strData)
        Info strData
    End If
End Sub

'vbLf, vbCr のみの場合
'vbCrlfに置換します
Function MyReplace(ByVal strData As String) As String
    Dim var         As Variant
    Dim x           As Variant
    Dim strRep      As String
    
    var = Split(strData, vbCrLf)
    For Each x In var
        strRep = strRep & Replace(x, vbCr, vbCrLf)
        strRep = Replace(strRep, vbLf, vbCrLf) & vbCrLf
    Next
    MyReplace = strRep
End Function

'テキストボックスにデータを表示します
Sub Info(ByVal strAddText As String)
    'データを追加していきます
    Text1.Text = Text1.Text & strAddText
    '下までスクロールします
    Text1.SelStart = Len(Text1.Text)
End Sub