HTTP Requests: POST, GET, Datei hochladen, Formular abschicken und Cookies mit VB.NET

So, 28.06.2009 - 16:59 -- admin

ToDO: Beschreibung

Webseite aufrufen

Dim http As New IntelligentStreaming.SharpTools.HTTPWorker()
Dim rsp As HttpWebResponse = Nothing
http.Url = "http://yoursite.com/pageToFetch.html"
http.Type = HTTPRequestType.[Get]
http.RequestObject.AllowAutoRedirect = False
' if required
Try
    rsp = http.SendRequest()
Catch ex As WebException
    Console.WriteLine(ex.Message)
    Return
End Try
 
Dim webPage As String = rsp.ResponseText

Login-Formular

Dim http As New IntelligentStreaming.SharpTools.HTTPWorker()
Dim rsp As HttpWebResponse = Nothing
http.Url = "http://yoursite.com/login.php"
http.Type = HTTPRequestType.Post
http.AddValue("username", username)
http.AddValue("password", password)
 
Try
    rsp = http.SendRequest()
Catch ex As WebException
    Console.WriteLine(ex.Message)
    Return
End Try
 
' You can now check for the response code with rsp.StatusCode to see what happened

Datei hochladen

Dim http As New IntelligentStreaming.SharpTools.HTTPWorker()
Dim rsp As HttpWebResponse = Nothing
 
http.Url = "http://website.com/mypage.php"
http.Type = IntelligentStreaming.SharpTools.HTTPRequestType.MultipartPost
 
http.RequestObject.KeepAlive = True
http.RequestObject.Headers.Add("Pragma", "no-cache")
 
http.AddValue("title", "Katy in Oslo")
http.AddValue("desc", "This is a picture of me in Oslo last summer.")
http.AddFile("file", FileName)
 
Try
    rsp = http.SendRequest()
Catch ex As WebException
    Console.WriteLine(ex.Message)
End Try

Klassen-Diagramm

HTTPWorker.vb

Imports System
Imports System.IO
Imports System.Net
Imports System.Text
 
Namespace IntelligentStreaming.SharpTools
    ''' <summary>
    ''' HTTP Method: GET, POST, or POST with files/attachments
    ''' </summary>
    Public Enum HTTPRequestType
        [Get]
        Post
        MultipartPost
    End Enum
 
    ''' <summary>
    ''' HTTP Helper Class
    ''' </summary>
    Public Class HTTPWorker
        Private req As HttpWebRequest
        Private rsp As HttpWebResponse
        Private rspText As String
        Private mimePayload As MIMEPayload
        Private m_cookies As CookieCollection
        Private m_persistCookies As Boolean
        Private postVars As String
 
        ''' <summary>
        ''' The URL of the next request. This must be set before any other parameters.
        ''' </summary>
        Public Property Url() As String
            Get
                If req Is Nothing Then
                    Return Nothing
                End If
 
                Return req.RequestUri.OriginalString
            End Get
            Set(ByVal value As String)
                req = DirectCast(WebRequest.Create(value), HttpWebRequest)
 
                ' This is to prevent the "417" status code error from web servers
                ' that don't support sending POST data in a follow-up request
                req.ServicePoint.Expect100Continue = False
 
                ' Don't allow 302 auto-redirects by default
                req.AllowAutoRedirect = False
            End Set
        End Property
 
        ''' <summary>
        ''' Set the request type. This must be set before any arguments are added
        ''' to the request, but after the URL is set.
        ''' </summary>
        Public WriteOnly Property Type() As HTTPRequestType
            Set(ByVal value As HTTPRequestType)
                If req Is Nothing Then
                    Throw New WebException("Set the URI first.")
                End If
 
                Select Case value
                    ' GET request
                    Case HTTPRequestType.[Get]
                        mimePayload = Nothing
                        postVars = Nothing
                        req.Method = "GET"
                        Exit Select
 
                        ' POST request
                    Case HTTPRequestType.Post
                        mimePayload = Nothing
                        postVars = ""
                        req.Method = "POST"
                        req.ContentType = "application/x-www-form-urlencoded"
                        Exit Select
 
                        ' POST request with attachments
                    Case HTTPRequestType.MultipartPost
                        mimePayload = New MIMEPayload()
                        postVars = Nothing
                        req.Method = "POST"
                        req.ContentType = "multipart/form-data; boundary=" & mimePayload.Boundary
                        Exit Select
                End Select
            End Set
        End Property
 
        ''' <summary>
        ''' Set to true to persist cookies between requests, false to discard cookies.
        ''' Cookies will always be saved after a request so this flag only applies to whether
        ''' the cookies are sent in the header of the next request (SendRequest()). If
        ''' PersistCookies is set to false and a new request made, all cookies stored up to
        ''' this point will be discarded.
        ''' </summary>
        Public Property PersistCookies() As Boolean
            Get
                Return m_persistCookies
            End Get
            Set(ByVal value As Boolean)
                m_persistCookies = value
            End Set
        End Property
 
        ''' <summary>
        ''' Add an argument to a POST request.
        ''' </summary>
        ''' <param name="key">Argument name</param>
        ''' <param name="value">Argument value</param>
        Public Sub AddValue(ByVal key As String, ByVal value As String)
            If postVars IsNot Nothing Then
                postVars += ((If((postVars.Length > 0), "&", "")) + key & "=") + value
            End If
 
            If mimePayload IsNot Nothing Then
                mimePayload.AddValue(key, value)
            End If
        End Sub
 
        ''' <summary>
        ''' Add a file to a multi-part POST request.
        ''' </summary>
        ''' <param name="key">Argument name</param>
        ''' <param name="value">Filename</param>
        Public Sub AddFile(ByVal key As String, ByVal value As String)
            If mimePayload Is Nothing Then
                Throw New Exception("Must use MultipartPost method to add files.")
            End If
 
            mimePayload.AddFile(key, value)
        End Sub
 
        ''' <summary>
        ''' Send the currently pending request.
        ''' </summary>
        ''' <returns>The HTTP response object</returns>
        Public Function SendRequest() As HttpWebResponse
            Dim st As Stream = Nothing
            rsp = Nothing
            rspText = Nothing
 
            ' Add previously stored cookies to the header if PersistCookies is on
            If m_persistCookies Then
                req.CookieContainer = New CookieContainer()
                For Each c As Cookie In m_cookies
                    req.CookieContainer.Add(c)
                Next
            Else
 
                ' Otherwise discard all previous cookies
                m_cookies = New CookieCollection()
            End If
 
            ' Create the request payload
            Dim data As Byte() = Nothing
 
            If req.Method = "GET" Then
                data = New Byte(-1) {}
            End If
 
            If req.Method = "POST" AndAlso mimePayload Is Nothing Then
                data = Encoding.ASCII.GetBytes(postVars)
            End If
 
            If req.Method = "POST" AndAlso mimePayload IsNot Nothing Then
                mimePayload.Finish()
                data = mimePayload.Data
            End If
 
            ' Send the request payload if there is one (not applicable for GET requests)
            If data.Length > 0 Then
                Try
                    req.ContentLength = data.Length
                    st = req.GetRequestStream()
                    st.Write(data, 0, data.Length)
                Catch ex As WebException
                    Throw ex
                Finally
                    If st IsNot Nothing Then
                        st.Close()
                    End If
                End Try
            End If
 
            ' Try to get the HTTP response
            Try
                rsp = DirectCast(req.GetResponse(), HttpWebResponse)
            Catch ex As WebException
                Throw ex
            End Try
 
            ' Remember newly sent cookies
            For Each c As Cookie In rsp.Cookies
                m_cookies.Add(c)
            Next
 
            ' Return the response
            Return rsp
        End Function
 
        Public ReadOnly Property RequestObject() As HttpWebRequest
            Get
                Return req
            End Get
        End Property
 
        Public ReadOnly Property ResponseObject() As HttpWebResponse
            Get
                Return rsp
            End Get
        End Property
 
        Public ReadOnly Property ResponseText() As String
            Get
                If rspText Is Nothing Then
                    Dim sr As New StreamReader(rsp.GetResponseStream())
                    rspText = sr.ReadToEnd()
                    sr.Close()
                End If
                Return rspText
            End Get
        End Property
 
        Public ReadOnly Property StatusCode() As HttpStatusCode
            Get
                Return rsp.StatusCode
            End Get
        End Property
 
        Public ReadOnly Property Cookies() As CookieCollection
            Get
                Return m_cookies
            End Get
        End Property
 
        Public Sub New()
            req = Nothing
            rsp = Nothing
            rspText = Nothing
            mimePayload = Nothing
            m_persistCookies = True
            m_cookies = New CookieCollection()
        End Sub
    End Class
 
    Public Class MIMEPayload
        Private Const m_boundary As String = "------------328523758298hjcwuie"
        Private m_data As Byte() = New Byte(-1) {}
 
        Public Sub AddValue(ByVal name As String, ByVal value As String)
            Dim text As String
            text = "--" & m_boundary & vbCr & vbLf
            text += "Content-Disposition: form-data; name=""" & name & """" & vbCr & vbLf & vbCr & vbLf
            text += value & vbCr & vbLf
 
            Dim bytes As Byte() = Encoding.ASCII.GetBytes(text)
 
            Dim final As Byte() = New Byte(m_data.Length + (bytes.Length - 1)) {}
            Buffer.BlockCopy(m_data, 0, final, 0, m_data.Length)
            Buffer.BlockCopy(bytes, 0, final, m_data.Length, bytes.Length)
            m_data = final
        End Sub
 
        Public Sub AddFile(ByVal name As String, ByVal fileName As String)
            Dim text As String
            text = "--" & m_boundary & vbCr & vbLf
            text += ("Content-Disposition: form-data; name=""" & name & """; filename=""") + fileName & """" & vbCr & vbLf
            text += "Content-Type: application/octet-stream" & vbCr & vbLf & vbCr & vbLf
 
            Dim textBytes As Byte() = Encoding.ASCII.GetBytes(text)
            Dim fileBytes As Byte()
 
            Try
                fileBytes = File.ReadAllBytes(fileName)
            Catch generatedExceptionName As Exception
                fileBytes = New Byte(-1) {}
            End Try
 
            Dim final As Byte() = New Byte(m_data.Length + textBytes.Length + fileBytes.Length + 1) {}
            Buffer.BlockCopy(m_data, 0, final, 0, m_data.Length)
            Buffer.BlockCopy(textBytes, 0, final, m_data.Length, textBytes.Length)
            Buffer.BlockCopy(fileBytes, 0, final, m_data.Length + textBytes.Length, fileBytes.Length)
            final(final.Length - 2) = 13
            final(final.Length - 1) = 10
            m_data = final
        End Sub
 
        Public Sub Finish()
            Dim bytes As Byte() = Encoding.ASCII.GetBytes("--" & m_boundary & "--")
 
            Dim final As Byte() = New Byte(m_data.Length + (bytes.Length - 1)) {}
            Buffer.BlockCopy(m_data, 0, final, 0, m_data.Length)
            Buffer.BlockCopy(bytes, 0, final, m_data.Length, bytes.Length)
            m_data = final
        End Sub
 
        Public ReadOnly Property Boundary() As String
            Get
                Return m_boundary
            End Get
        End Property
 
        Public ReadOnly Property Data() As Byte()
            Get
                Return m_data
            End Get
        End Property
    End Class
End Namespace