Private m_strRemoteHost As String 'the web server to connect to
Private m_strFilePath As String 'relative path to the file to retrieve
Private m_strHttpResponse As String 'the server response
Private m_bResponseReceived As Boolean
'
Private Sub cmdReadURL_Click()
'
Dim strURL As String 'temporary buffer
'
On Error GoTo ERROR_HANDLER
'
'check the textbox
If Len(txtURL) = 0 Then
MsgBox "Please, enter the URL to retrieve.", vbInformation
Exit Sub
End If
'
'if the user has entered "http://", remove this substring
'
If Left(txtURL, 7) = "http://" Then
strURL = Mid(txtURL, 8)
Else
strURL = txtURL
End If
'
'get remote host name
'
m_strRemoteHost = Left$(strURL, InStr(1, strURL, "/") - 1)
'
'get relative path to the file to retrieve
'
m_strFilePath = Mid$(strURL, InStr(1, strURL, "/"))
'
'clear the RichTextBox
'
rtbDocument.Text = ""
'
'clear the buffer
'
m_strHttpResponse = ""
'
'turn off the m_bResponseReceived flag
'
m_bResponseReceived = False
'
'establish the connection
'
With wscHttp
.Close
.LocalPort = 0
.Connect m_strRemoteHost, 80
End With
'
EXIT_LABEL:
Exit Sub
ERROR_HANDLER:
'
If Err.Number = 5 Then
strURL = strURL & "/"
Resume 0
Else
MsgBox "Error was occurred." & vbCrLf & _
"Error #: " & Err.Number & vbCrLf & _
"Description: " & Err.Description, vbExclamation
GoTo EXIT_LABEL
End If
'
End Sub
Private Sub Form_Load()
End Sub
Private Sub wscHttp_Close()
'
Dim strHttpResponseHeader As String
'
'to cut of the header info, we must find
'a blank line (vbCrLf & vbCrLf)
'that separates the message body from the header
'
If Not m_bResponseReceived Then
strHttpResponseHeader = Left$(m_strHttpResponse, _
InStr(1, m_strHttpResponse, _
vbCrLf & vbCrLf) - 1)
Debug.Print strHttpResponseHeader
m_strHttpResponse = Mid(m_strHttpResponse, _
InStr(1, m_strHttpResponse, _
vbCrLf & vbCrLf) + 4)
'
'pass the document data to the RichTextBox control
'
rtbDocument.Text = m_strHttpResponse
'
'turn on the m_bResponseReceived flag
'
m_bResponseReceived = True
'
End If
'
End Sub
Private Sub wscHttp_Connect()
'
Dim strHttpRequest As String
'
'create the HTTP Request
'
'build request line that contains the HTTP method,
'path to the file to retrieve,
'and HTTP version info. Each line of the request
'must be completed by the vbCrLf
strHttpRequest = "GET " & m_strFilePath & " HTTP/1.1" & vbCrLf
'
'add HTTP headers to the request
'
'add required header - "Host", that contains the remote host name
'
strHttpRequest = strHttpRequest & "Host: " & m_strRemoteHost & vbCrLf
'
'add the "Connection" header to force the server to close the connection
'
strHttpRequest = strHttpRequest & "Connection: close" & vbCrLf
'
'add optional header "Accept"
'
strHttpRequest = strHttpRequest & "Accept: */*" & vbCrLf
'
'add other optional headers
'
'strHttpRequest = strHttpRequest & <Header Name> & _
<Header Value> & vbCrLf
'. . .
'
'add a blank line that indicates the end of the request
strHttpRequest = strHttpRequest & vbCrLf
'
'send the request
wscHttp.SendData strHttpRequest
'
Debug.Print strHttpRequest
'
End Sub
Private Sub wscHttp_DataArrival(ByVal bytesTotal As Long)
'
On Error Resume Next
'
Dim strData As String
'
'get arrived data from winsock buffer
'
wscHttp.GetData strData
'
'store the data in the m_strHttpResponse variable
m_strHttpResponse = m_strHttpResponse & strData
'
End Sub
Reply With Quote
