Jump to content
Sign in to follow this  
Lord Nikon

HTTP Client

Recommended Posts

This is a usercontrol that uses the Miscrosoft Winsock control to create a virtual HTTP Client. It is like a browser only it can't change the HTML into an interactive page.

 

To use it is quite simple you simply add a new Usercontrol to your project and use this code for it:

Option Explicit
Dim Host			As String
Dim strRequest	  As String
Dim strIncoming	 As String
Public LastPage	 As String
Dim m_Cookie		As String
Dim strPacket	   As String
Dim strParts()	  As String
Dim Regex		   As RegExp
Dim m_Match		 As Match
Dim m_Matches	   As MatchCollection
Private Declare Function DecompressGzipData Lib "nvrgzipd.dll" (ByVal sData As String, ByVal lDataSize As Long) As String

Public Function Request(ByVal Method As String, ByVal strURL As String, Optional ByVal Referer As String = "") As String
Dim iLen As Long
If InStr(1, strURL, "http://") <> 0 Then
	Host = Mid$(strURL, 8)
End If
If InStr(1, Host, "?") <> 0 And Method = "POST" Then
	iLen = InStr(1, Host, "?")
	strURL = "http://" & Mid$(Host, 1, iLen - 1)
	strPacket = Mid$(Host, iLen + 1)
End If
If InStr(1, Host, "/") <> 0 Then
	iLen = InStr(1, Host, "/")
	Host = Mid$(Host, 1, iLen - 1)
End If

If IsMissing(Referer) = True And LastPage <> "" Then
	Referer = LastPage
ElseIf IsMissing(Referer) = True And LastPage = "" Then
	Referer = "http://www.google.com/"
	LastPage = "http://www.google.com/"
End If

If UCase(Method) = "GET" Then
	strRequest = "GET " & strURL & " HTTP/1.1" & vbCrLf _
		& "Host: " & Host & vbCrLf _
		& "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7.7) Gecko/20050414 Firefox/1.0.3" & vbCrLf _
		& "Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5" & vbCrLf _
		& "Accept-Language: en-us,en;q=0.5" & vbCrLf _
		& "Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7" & vbCrLf _
		& "Accept-Encoding: gzip, deflate" & vbCrLf _
		& "Referer: " & Referer & vbCrLf _
		& "Cookie: " & m_Cookie & vbCrLf _
		& "Connection: close" & vbCrLf & vbCrLf
Else
	strRequest = "POST " & strURL & " HTTP/1.1" & vbCrLf _
		& "Host: " & Host & vbCrLf _
		& "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7.7) Gecko/20050414 Firefox/1.0.3" & vbCrLf _
		& "Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5" & vbCrLf _
		& "Accept-Language: en-us,en;q=0.5" & vbCrLf _
		& "Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7" & vbCrLf _
		& "Accept-Encoding: gzip, deflate" & vbCrLf _
		& "Referer: " & Referer & vbCrLf _
		& "Cookie: " & m_Cookie & vbCrLf _
		& "Content-Type: application/x-www-form-urlencoded" & vbCrLf _
		& "Content-Length: " & Len(strPacket) & vbCrLf _
		& "Connection: close" & vbCrLf & vbCrLf _
		& strPacket & vbCrLf
End If

If wsa.State <> 0 Then wsa.Close

wsa.Connect Host, 80
curState.Caption = wsa.State

Do Until wsa.State = 7
	DoEvents
Loop
curState.Caption = wsa.State
wsa.SendData strRequest

Do Until wsa.State = 0
	DoEvents
Loop
curState.Caption = wsa.State

If strIncoming = Empty Then GoTo SendAgain
strParts = Split(strIncoming, vbCrLf & vbCrLf)

If GetHttpHeaderValue("Content-Encoding") = "gzip" Then
	Request = strParts(0) & DecompressGzip(LenB(StrConv(strParts(1), vbFromUnicode)) + 1000)
ElseIf GetHttpHeaderValue("Content-Encoding") = "chunked" Then
	Request = strParts(0) & DecodeChunkedMessage
Else
	Request = strIncoming
End If

LastPage = strURL
m_Cookie = ParseCookies(strParts(0), m_Cookie)
Exit Function
SendAgain:
Request = Request(Method, strURL, Referer)
End Function

Private Function DecodeChunkedMessage() As String
Dim lngPosA As Long
Dim lngPosB As Long
Dim intOctetsToRead As Integer
Dim strTempBuffer As String

Const CRLF_LENGTH = 2

lngPosA = InStr(1, strParts(1), vbCrLf)
intOctetsToRead = Val("&H" & Left(strParts(1), lngPosA - 1))

Do Until intOctetsToRead = 0
	strTempBuffer = strTempBuffer & Mid$(strParts(1), lngPosA + CRLF_LENGTH, intOctetsToRead)
	lngPosB = lngPosA + CRLF_LENGTH + intOctetsToRead + CRLF_LENGTH
	lngPosA = InStr(lngPosB, strParts(1), vbCrLf)
	intOctetsToRead = Val("&H" & Mid$(strParts(1), lngPosB, lngPosA - lngPosB))
Loop

DecodeChunkedMessage = strTempBuffer
End Function

Private Function GetHttpHeaderValue(strValueName As String) As String
Dim strHeaders() As String
Dim varHeaders As Variant

strHeaders = Split(strParts(0), vbCrLf)
For Each varHeaders In strHeaders
	varHeaders = LCase(varHeaders)
	If InStr(varHeaders, LCase(strValueName)) > 0 Then
		GetHttpHeaderValue = Trim$(Mid$(varHeaders, InStr(varHeaders, Chr(32))))
		Exit Function
	End If
Next
End Function

Private Function DecompressGzip(lngLength As Long) As String
DecompressGzip = DecompressGzipData(strParts(1), lngLength)
End Function

Public Function ParseCookies(strHeader As String, strOldCookies As String) As String
Dim udtVars() As String
Dim udtVals() As String
Dim strTemp As String
Dim X As Long
Dim strFinal As String
Dim intCount As Long
Dim strSource As String: strSource = strHeader & strOldCookies
Set Regex = New RegExp
Regex.Global = True
Regex.IgnoreCase = True
Regex.MultiLine = True
Regex.Pattern = "Set-Cookie:\s*(.+?)=(.+?);"

strOldCookies = "Set-Cookie: " & strOldCookies

Set m_Matches = Regex.Execute(strSource)
For Each m_Match In m_Matches
	Set m_Match = m_Matches(intCount)
	strTemp = strTemp & m_Match.SubMatches(0) & vbCrLf
	intCount = intCount + 1
Next
udtVars = Split(strTemp, vbCrLf)
strTemp = ""
intCount = 0

Set m_Matches = Regex.Execute(strSource)
For Each m_Match In m_Matches
	Set m_Match = m_Matches(intCount)
	strTemp = strTemp & m_Match.SubMatches(1) & vbCrLf
	intCount = intCount + 1
Next
udtVals = Split(strTemp, vbCrLf)

For X = 0 To UBound(udtVars) - 1
	If InStr(1, strFinal, udtVars(X)) = 0 Then
		strFinal = strFinal & udtVars(X) & "=" & udtVals(X) & ";"
	End If
Next X
ParseCookies = strFinal
End Function

Private Sub wsa_Close()
curState.Caption = wsa.State
wsa.Close
End Sub

Private Sub wsa_Connect()
curState.Caption = wsa.State
strIncoming = ""
End Sub

Private Sub wsa_DataArrival(ByVal bytesTotal As Long)
Dim Data As String

wsa.GetData Data, vbString
strIncoming = strIncoming & Data
End Sub

 

How to use:

This is to use the GET command to retrieve the page source of google.ca

Private Sub Command1_Click()
Text1.Text = HTTP.Request("GET", "http://www.google.ca/", HTTP.LastPage)
End Sub

 

This is to use the POST command to retrieve a login action on the APH forums:

Private Sub Command1_Click()
Text1.Text = HTTP.Request("POST", "http://www.aphnetworks.com/forums/index.php?act=Login&CODE=01?referer=&UserName=lord+nikon&PassWord=password&CookieDate=1", "http://www.aphnetworks.com/forums/index.php?act=Login&CODE=00")
End Sub

 

The wrapper doesn't have all the fancy features but it's still very fast and convenient. Credits goto xx_WLT_xx' GZip library and his 2 other functions. You don't have to have GZip either you can easily take GZip out. :rofl:

 

Enjoy :o

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
Sign in to follow this  

×
×
  • Create New...