|
Inactive
Join Date: Jul 2004
Location: 127.0.0.1
Services: 50MB Virgin w/ TiVo 1TB
Posts: 1,255
|
VB.NET HTTP Wrapper portation problems
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)
Code:
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
Code:
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
|