VB.NET HTTP Wrapper portation problems

[LemonyBrainAid]

Hi there,

I'm a programmer - Mainly VB6, but some VB.NET - and I've been trying to port a Wrapper* for HTTP to Visual Basic .NET from VB6...

I seem to have done most of it, yet I still get some errors.

* For those of you who don't know, a HTTP Wrapper is a Website manipulator with some extras added in. With the wrapper in question, you can GET, POST and store cookies via winsock.

NOTE: This was in a UserControl with a Winsock Control named "Winsock1", a label named "CurState" and a Timer named "Timer1" (All of which will be auto-put onto the form if you copy and paste all the code)

This is the new VB.NET Code (Quite long, beware)

Option Explicit On 
Public Class HTTPWrapper
	Inherits System.Windows.Forms.UserControl

#Region " Windows Form Designer generated code "

	Public Sub New()
		MyBase.New()

		'This call is required by the Windows Form Designer.
		InitializeComponent()

		'Add any initialization after the InitializeComponent() call

	End Sub

	'UserControl overrides dispose to clean up the component list.
	Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
		If disposing Then
			If Not (components Is Nothing) Then
				components.Dispose()
			End If
		End If
		MyBase.Dispose(disposing)
	End Sub

	'Required by the Windows Form Designer
	Private components As System.ComponentModel.IContainer

	'NOTE: The following procedure is required by the Windows Form Designer
	'It can be modified using the Windows Form Designer.  
	'Do not modify it using the code editor.
	Friend WithEvents Timer1 As System.Timers.Timer
	Friend WithEvents CurState As System.Windows.Forms.Label
	Friend WithEvents Winsock1 As AxMSWinsockLib.AxWinsock
	<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
		Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(HTTPWrapper))
		Me.Winsock1 = New AxMSWinsockLib.AxWinsock
		Me.Timer1 = New System.Timers.Timer
		Me.CurState = New System.Windows.Forms.Label
		CType(Me.Winsock1, System.ComponentModel.ISupportInitialize).BeginInit()
		CType(Me.Timer1, System.ComponentModel.ISupportInitialize).BeginInit()
		Me.SuspendLayout()
		'
		'Winsock1
		'
		Me.Winsock1.Enabled = True
		Me.Winsock1.Location = New System.Drawing.Point(32, 8)
		Me.Winsock1.Name = "Winsock1"
		Me.Winsock1.OcxState = CType(resources.GetObject("Winsock1.OcxState"), System.Windows.Forms.AxHost.State)
		Me.Winsock1.Size = New System.Drawing.Size(28, 28)
		Me.Winsock1.TabIndex = 0
		'
		'Timer1
		'
		Me.Timer1.Enabled = True
		Me.Timer1.SynchronizingObject = Me
		'
		'CurState
		'
		Me.CurState.Font = New System.Drawing.Font("Arial", 8.25!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
		Me.CurState.Location = New System.Drawing.Point(0, 0)
		Me.CurState.Name = "CurState"
		Me.CurState.Size = New System.Drawing.Size(8, 16)
		Me.CurState.TabIndex = 1
		Me.CurState.Text = "0"
		'
		'HTTPWrapper
		'
		Me.Controls.Add(Me.CurState)
		Me.Controls.Add(Me.Winsock1)
		Me.Name = "HTTPWrapper"
		Me.Size = New System.Drawing.Size(16, 16)
		CType(Me.Winsock1, System.ComponentModel.ISupportInitialize).EndInit()
		CType(Me.Timer1, System.ComponentModel.ISupportInitialize).EndInit()
		Me.ResumeLayout(False)

	End Sub

#End Region


	Dim Cookies() As tData

	Public StopIT As Boolean
	Public DontParseHttp As Boolean

	Public LastPage As String

	Public UBoundCookies As Integer

	Dim strKomplett As String
	Dim strINC As String

	Const HTTPRequest As String = "%Action n File%" & vbCrLf & _
	   "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*" & vbCrLf & _
	   "%Referer%" & _
	   "Accept-Language: en-us" & vbCrLf & _
	   "Content-Type: application/x-www-form-urlencoded" & vbCrLf & _
	   "Accept-Encoding: " & vbCrLf & _
	   "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)" & vbCrLf & _
	   "Host: %Host%" & vbCrLf & _
	   "%Content-Length%" & _
	   "Connection: Close" & vbCrLf & _
	   "%Cookies%" & _
	   vbCrLf & "%Data%"

	Public Event CookieUpdate(ByVal ChangedCookies() As Integer)
	Private Function FormPOST(ByVal File As String, ByVal HOST As String, ByVal Data As String, Optional ByVal Referer As String = "") As String

		Dim tmpVar As String

		tmpVar = Replace(HTTPRequest, "%Action n File%", "POST " & File & " HTTP/1.1")
		tmpVar = Replace(tmpVar, "%Referer%", Referer)
		tmpVar = Replace(tmpVar, "%Host%", HOST)
		tmpVar = Replace(tmpVar, "%Content-Length%", "Content-Length: " & Len(Data) & vbCrLf)
		tmpVar = Replace(tmpVar, "%Cookies%", BuildHttpCookies(Cookies))
		tmpVar = Replace(tmpVar, "%Data%", Data)

		FormPOST = tmpVar

	End Function
	Private Function GETPage(ByVal File As String, ByVal HOST As String, Optional ByVal Referer As String = "") As String

		Dim tmpVar As String

		tmpVar = Replace(HTTPRequest, "%Action n File%", "GET " & File & " HTTP/1.1")
		tmpVar = Replace(tmpVar, "%Referer%", Referer)
		tmpVar = Replace(tmpVar, "%Host%", HOST)
		tmpVar = Replace(tmpVar, "%Content-Length%", "")
		'tmpVar = Replace(tmpVar, "%Cookies%", BuildHttpCookies(Cookies))
		tmpVar = Replace(tmpVar, "%Data%", "")

		GETPage = tmpVar

	End Function
	Public Function GetWrapper(ByVal URL As String, Optional ByVal Referer As String = "") As String

		Dim TempRef As String
		Dim HostX As String
		Dim Tempfile As String
		Dim FileX As String

		If Referer <> "" Then
			TempRef = "Referer: " & Referer & vbCrLf
		Else
			TempRef = ""
		End If

		Call WaitForWinSockClose()

		If LCase$(Microsoft.VisualBasic.Left$(URL, 7)) = "http://" Then
			Tempfile = Mid$(URL, 8)
		Else
			Tempfile = URL
		End If

		HostX = Microsoft.VisualBasic.Left$(Tempfile, InStr(1, Tempfile, "/") - 1)
		FileX = Mid$(Tempfile, InStr(1, Tempfile, "/"))

		If Winsock1.CtlState <> 0 Then
			Winsock1.Close()
			Call WaitForWinSockClose()
		End If

		Winsock1.RemoteHost = HostX
		Winsock1.RemotePort = 80
		Winsock1.LocalPort = 0

		If Not StopIT And Winsock1.CtlState <> 7 Then
			Winsock1.Connect()
		End If

		Call WaitForWinSockConnect()

		If Not StopIT Then
			Winsock1.SendData(GETPage(FileX, HostX, TempRef))
		End If

		Call WaitForWinSockClose()

		LastPage = URL
		If LCase$(Microsoft.VisualBasic.Left$(URL, 7)) <> "http://" Then
			LastPage = "http://" & LastPage
		End If

		If DontParseHttp Then
			GetWrapper = strKomplett
		Else
			GetWrapper = HTTParse(strKomplett)
		End If

	End Function

	Public Function PostWrapper(ByVal URL As String, ByVal Datastring As String, Optional ByVal Referer As String = "") As String

		Dim TempRef As String
		Dim HostX As String
		Dim Tempfile As String
		Dim FileX As String

		If Referer <> "" Then
			TempRef = "Referer: " & Referer & vbCrLf
		Else
			TempRef = ""
		End If

		If LCase$(Microsoft.VisualBasic.Left$(URL, 7)) = "http://" Then
			Tempfile = Mid$(URL, 8)
		Else
			Tempfile = URL
		End If

		HostX = Microsoft.VisualBasic.Left$(Tempfile, InStr(1, Tempfile, "/") - 1)
		FileX = Mid$(Tempfile, InStr(1, Tempfile, "/"))

		If Winsock1.CtlState <> 0 Then
			Winsock1.Close()
			Call WaitForWinSockClose()
		End If

		Winsock1.RemoteHost = HostX
		Winsock1.RemotePort = 80
		Winsock1.LocalPort = 0

		If Not StopIT And Winsock1.CtlState <> 7 Then
			Winsock1.Connect()
		End If

		Call WaitForWinSockConnect()

		If Not StopIT Then
		    Winsock1.SendData(FormPOST(FileX, HostX, Datastring, TempRef))
		End If

		Call WaitForWinSockClose()

		LastPage = URL
		If LCase$(Microsoft.VisualBasic.Left$(URL, 7)) <> "http://" Then
			LastPage = "http://" & LastPage
		End If

		If DontParseHttp Then
			PostWrapper = strKomplett
		Else
			PostWrapper = HTTParse(strKomplett)
		End If

	End Function

	Private Function HTTParse(ByRef ServerHttp As String) As String

		Dim HTTPHeader As String
		Dim HTTPBody As String
		Dim Msg As String
		Dim Chunksize As Long
		Dim TN(2) As Integer


		TN(1) = InStr(1, ServerHttp, vbCrLf & vbCrLf)
		HTTPHeader = Mid$(ServerHttp, 1, TN(1))
		If InStr(1, HTTPHeader, "Transfer-Encoding: chunked") <> 0 Then
			Msg = Mid$(ServerHttp, TN(1) + 4)
			TN(1) = InStr(1, Msg, vbCrLf) - 1
			Chunksize = Dez(Mid$(Msg, 1, TN(1)))
			TN(1) = TN(1) + 3
			Do Until Chunksize = 0
			    HTTPBody = HTTPBody & Mid$(Msg, TN(1), Chunksize)
				TN(1) = TN(1) + Chunksize + 2
				TN(2) = InStr(TN(1) + 1, Msg, vbCrLf)
				If TN(2) = 0 Then Exit Do
			    Chunksize = Dez(Mid$(Msg, TN(1), TN(2) - TN(1)))
				TN(1) = TN(2) + 2
			Loop
		    HTTParse = HTTPHeader & vbCrLf & vbCrLf & HTTPBody
		Else
			HTTParse = ServerHttp
		End If

	End Function

	Private Function BuildHttpCookies(ByVal CookieData() As tData) As String

		Dim CookieString As String
		Dim x As Integer

		If LBound(CookieData) <> UBound(CookieData) Then
			For x = LBound(CookieData) To UBound(CookieData)
			    CookieString = CookieString & CookieData(x).Key & "=" & CookieData(x).Value & "; "
			Next
		    CookieString = Microsoft.VisualBasic.Left$(CookieString, Len(CookieString) - 2)
		End If

		If CookieString <> "" Then
			CookieString = "Cookie: " & CookieString & vbCrLf
		End If

		BuildHttpCookies = CookieString

	End Function

	Private Sub DecodeCookies()

		Dim TN(1) As Integer

		Dim TempCookie() As String
		Dim x As Integer
		Dim Ok2Add As Boolean
		Dim IsChanged As Boolean
		Dim ChangedCookies() As Integer
		Dim y As Integer

		TN(1) = 0
		y = 0
		ReDim ChangedCookies(20)
		Do While True
			TN(1) = InStr(TN(1) + 1, strINC, "Set-Cookie: ") + 12
			If TN(1) = 12 Then Exit Do
			TN(2) = InStr(TN(1), strINC, ";")
			If TN(2) = 0 Then Exit Do

			TempCookie = Split(Mid$(strINC, TN(1), TN(2) - TN(1)), "=")
			Ok2Add = True
			For x = 0 To UBound(Cookies)
			    If Cookies(x).Key = TempCookie(0) Then
				    Ok2Add = False
				    Cookies(x).Value = TempCookie(1)
				    IsChanged = True
				    If y > 20 Then ReDim Preserve ChangedCookies(y + 1)
					y = y + 1
				End If
			Next
			If Ok2Add Then
			    If Cookies(UBound(Cookies)).Key <> "" Then
				    ReDim Preserve Cookies(UBound(Cookies) + 1)
				End If
			    Cookies(UBound(Cookies)) = FormData(TempCookie(0), TempCookie(1))
				IsChanged = True
				ChangedCookies(y) = UBound(Cookies)
				y = y + 1
			End If
		Loop
		strKomplett = strINC
		strINC = ""
		Winsock1.Close()
		UBoundCookies = UBound(Cookies)

		If IsChanged Then
			ReDim Preserve ChangedCookies(y)
			RaiseEvent CookieUpdate(ChangedCookies)
		End If

	End Sub
	Public Function SocketState()

		SocketState = Winsock1.CtlState

	End Function
	Private Sub CurState_Change()

		CurState.Refresh()
		'HTTPWrapper.

	End Sub

	Private Sub UserControl_Initialize()

		ReDim Cookies(0)

		DontParseHttp = False
		StopIT = False

	End Sub

	Private Sub UserControl_Terminate()

		Winsock1.Close()
		Call WaitForWinSockClose()

	End Sub

	Private Sub Winsock1_Close()

		DecodeCookies()
		Winsock1.Tag = ""

	End Sub

	Private Sub Winsock1_Connect()

		strINC = ""

	End Sub

	Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

		Dim strArrival As String

		strArrival = ""
		Winsock1.GetData(strArrival)
		strINC = strINC & strArrival

	End Sub

	Private Sub Winsock1_Error(ByVal Number As Integer, ByVal Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, ByVal CancelDisplay As Boolean)

		Winsock1.Close()

	End Sub

	Private Sub Timer1_Timer()

		If DesignMode = True Then
			Timer1.Enabled = True
		ElseIf DesignMode = False Then
			Timer1.Enabled = False
		End If
		CurState.Text = Winsock1.CtlState
		If Winsock1.CtlState = 8 And Winsock1.Tag = "" Then
			Winsock1.Close()
			Winsock1.Tag = "Closing"
		End If

	End Sub

	Private Function Dez(ByVal h As String) As Decimal



		Dim Tmp$
		Dim lo1 As Integer
		Dim lo2 As Integer
		Dim hi1 As Long
		Dim hi2 As Long
		Const Hx = "&H"
		Const BigShift = 65536
		Const LilShift = 256, Two = 2

		Tmp = h

		'In case "&H" is present
		If UCase$(Microsoft.VisualBasic.Left$(h, 2)) = "&H" Then
			Tmp = Mid$(h, 3)
		End If

		'In case there are too few characters
		Tmp = Microsoft.VisualBasic.Right$("0000000" & Tmp, 8)

		'In case it wasn't a valid number
		If IsNumeric(Hx & Tmp) Then
			lo1 = CInt(Hx & Microsoft.VisualBasic.Right$(Tmp, Two))
			hi1 = CLng(Hx & Mid$(Tmp, 5, Two))
			lo2 = CInt(Hx & Mid$(Tmp, 3, Two))
			hi2 = CLng(Hx & Microsoft.VisualBasic.Left$(Tmp, Two))
			Dez = CDec(hi2 * LilShift + lo2) * BigShift + (hi1 * LilShift) + lo1

		End If

	End Function

	Public Function CookieKey_GET(ByVal CIndex As Integer) As String

		CookieKey_GET = Cookies(CIndex).Key

	End Function

	Public Function CookieValue_GET(ByVal CIndex As Integer) As String

		CookieValue_GET = Cookies(CIndex).Value

	End Function

	Public Sub CookieKey_SET(ByVal CIndex As Integer, ByVal CookieKey As String)

		Dim ChangedCookies(0) As Integer

		If CIndex > UBound(Cookies) Then
			ReDim Preserve Cookies(CIndex)
			UBoundCookies = UBound(Cookies)
		End If

		Cookies(CIndex).Key = CookieKey
		ChangedCookies(0) = CIndex
		RaiseEvent CookieUpdate(ChangedCookies)

	End Sub

	Public Sub CookieValue_SET(ByVal CIndex As Integer, ByVal CookieValue As String)

		Dim ChangedCookies(0) As Integer

		If CIndex > UBound(Cookies) Then
			ReDim Preserve Cookies(CIndex)
			UBoundCookies = UBound(Cookies)
		End If

		Cookies(CIndex).Value = CookieValue
		ChangedCookies(0) = CIndex
		RaiseEvent CookieUpdate(ChangedCookies)

	End Sub

	Public Sub ClearCookies()

		Dim ChangedCookies() As Integer
		Dim x As Integer, y As Integer

		ReDim ChangedCookies(UBound(Cookies))

		y = 0
		For x = UBound(Cookies) To 0 Step -1
			ChangedCookies(y) = (x * (-1)) - 1
			y = y + 1
		Next

		ReDim Cookies(0)
		UBoundCookies = UBound(Cookies)
		RaiseEvent CookieUpdate(ChangedCookies)

	End Sub

	Public Sub RemoveCookie(ByVal CIndex As Integer)

		Dim ChangedCookies(0) As Integer
		Dim x As Integer

		For x = CIndex To UBound(Cookies) - 1
			Cookies(x).Key = Cookies(x + 1).Key
			Cookies(x).Value = Cookies(x + 1).Value
		Next

		ReDim Preserve Cookies(UBound(Cookies) - 1)
		UBoundCookies = UBound(Cookies)
		ChangedCookies(0) = (CIndex * (-1)) - 1
		RaiseEvent CookieUpdate(ChangedCookies)

	End Sub

	Private Sub WaitForWinSockClose()
		MsgBox("0")
		Dim waitUntilTime As Date

		waitUntilTime = DateAdd("s", 7.0#, Now) 'timeout is 7 seconds from now

		Do Until Winsock1.CtlState = 0
			'Sleep(0)
			If waitUntilTime < Now Then
				Winsock1.Close() 'try again
				Call WaitForWinSockClose()
			End If
		Loop

	End Sub

	Private Sub WaitForWinSockConnect()
		MsgBox("1")
		Dim waitUntilTime As Date

		waitUntilTime = DateAdd("s", 7.0#, Now) 'timeout is 7 seconds from now

		Do Until Winsock1.CtlState = 7 Or StopIT

			'Sleep(0)
			If waitUntilTime < Now Then
				Winsock1.Close()
				Call WaitForWinSockClose()
			    Winsock1.Connect() 'try connecting again
				Call WaitForWinSockConnect()
			End If
		Loop

	End Sub

End Class

The only problems I seem to have is that in the CurState_Change() sub, The usercontrol is supposed to refresh. In VB6, the answer would be

 UserControl.Refresh

yet, in VB.NET I don't seem to have that property.
Any ideas?

That is the only error in the code, everything else looks OK.

But, I just checked the workability of the GetWrapper function and it seems it isn't returning any HTML. Any ideas why?

Thanks in advance,
Dan

[Richard M]

That's some pretty heavy code there LBA, I'll have a look at it in Visual Studio tomorrow if I get the chance.

[philip.j.fry]

Originally Posted by Richard M

That's some pretty heavy code there LBA, I'll have a look at it in Visual Studio tomorrow if I get the chance.

Lightweight

I don't know any/much VB I'm afraid Lemony, but a quick look on the MSDN api page for the Label class suggests that .Refresh should work.

[Gareth]

Heh, I used to be a code monkey, but now I've got a proper job

Unfortunately for LBA, however, I never got into VB .NET, as I went to Java after VB6 and never looked back. Java is a real language

[philip.j.fry]

Originally Posted by Gareth

Heh, I used to be a code monkey, but now I've got a proper job

Unfortunately for LBA, however, I never got into VB .NET, as I went to Java after VB6 and never looked back. Java is a real language

Java's the main language I use too, still look wistfully at c at times though

[Richard M]

I use PHP for web stuff but I find C# (.NET) is real handy for apps because it takes care of garbage collection, memory allocation etc.
I don't like VB but that's mainly because every line doesn't end in a semi colon.

[nffc]

I'm lost. Don't you lads have footballs or playstations any more?

[Richard M]

You don't need a Playstation when a PC looks like this.

[nffc]

Originally Posted by Richard M

You don't need a Playstation when a PC looks like this.

Yeah but my point is, when i was his age, all we ever did was play football. Not VB.NET (well, it wasn't invented 8-9 years ago) or any kind of programming...

[Richard M]

I did, I wrote my first game when I was 9.
It was a text adventure game and I remember being really proud of the custom font I used.

[nffc]

Originally Posted by Richard M

I did, I wrote my first game when I was 9.
It was a text adventure game and I remember being really proud of the custom font I used.

You're older than me as well...

[philip.j.fry]

Originally Posted by Richard M

garbage collection, memory allocation etc.

That's what I don't like, I like pointers (and making things harder for myself than they need to be!)

[LemonyBrainAid]

Whoops - Forgot to mention a module...

Option Explicit On 
Module Module1
	Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
	Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
	Declare Function timeGetTime Lib "winmm.dll" () As Long
	Public Structure tData
		Dim Key As String
		Dim Value As String
	End Structure



	Public Function FormData(ByVal Key As String, ByVal Value As String) As tData 'saves a few lines....
		FormData.Key = Key
		FormData.Value = Value
	End Function

	Public Function tData2String(ByVal ExtraData() As tData) As String
		Dim Datastring As String
		Dim x As Integer

		For x = LBound(ExtraData) To UBound(ExtraData)
		    Datastring = Datastring & ExtraData(x).Key & "=" & ExtraData(x).Value & "&"
		Next
		tData2String = Left$(Datastring, Len(Datastring) - 1)
	End Function

End Module

[LemonyBrainAid]

Managed to find the answer on MSDN

I had to substitute

HTTPWrapper.Refresh

with

		Dim myWrapper As New HTTPWrapper
		myWrapper.Refresh()

[Raistlin]

So I was on the right lines when I said to try .Refresh() then? - almost

Cool

Glad you've got it sorted well done