Option Explicit

Dim sPage As String
Dim WithEvents wsTCP As OSWINSCK.Winsock
Dim txtSource As String

Public Function GetServerData() As Boolean
On Error GoTo ErrHandler
  Dim sServer As String
  Dim nPort As Long
  Dim txtURL As String
  
  txtURL = "http://www.google.com"
  
  nPort = 80
  sServer = Trim(txtURL)
  If InStr(sServer, "://") > 0 Then _
     sServer = Mid(sServer, InStr(sServer, "://") + 3)
  If InStr(sServer, "/") > 0 Then
    sPage = Mid(sServer, InStr(sServer, "/") + 1)
    sServer = Left(sServer, InStr(sServer, "/") - 1)
  End If
  If InStr(sServer, ":") > 0 Then
    nPort = Mid(sServer, InStr(sServer, ":") + 1)
    sServer = Left(sServer, InStr(sServer, ":") - 1)
  End If
  If sServer = "" Then Err.Raise 12001, , "Invalid URL"
  
  Set wsTCP = CreateObject("OSWINSCK.Winsock")
  wsTCP.Connect sServer, nPort
  GetServerData = True
  Exit Function

ErrHandler:
  MsgBox "Error " & Err.Number & ": " & Err.Description
  GetServerData = False
End Function

Private Sub wsTCP_OnClose()
  wsTCP.CloseWinsock
End Sub

Private Sub wsTCP_OnConnect()
  wsTCP.SendData "GET /" & sPage & " HTTP/1.0" & vbCrLf & vbCrLf
End Sub

Private Sub wsTCP_OnDataArrival(ByVal bytesTotal As Long)
  Dim sBuffer As String
  wsTCP.GetData sBuffer
  txtSource = txtSource & sBuffer
  Debug.Print txtSource
End Sub

Private Sub wsTCP_OnError(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)
  MsgBox Number & ": " & Description
End Sub

Private Sub wsTCP_OnStatusChanged(ByVal Status As String)
  Debug.Print Status
End Sub