vb.net socket实现http上传下载

原创 2007年09月21日 18:56:00

Imports System

Imports System.Text

Imports System.IO

Imports System.Net

Imports System.Net.Sockets

Imports Microsoft.VisualBasic

 

''' <summary>

''' 实现向web发送和接收数据的类

''' </summary>

''' <remarks></remarks>

Public Class WebClient

 

    Const BOUNDARY As String = "--HEDAODE--"

    Const SEND_BUFFER_SIZE As Integer = 8000

    Const RECEIVE_BUFFER_SIZE As Integer = 15000

 

    Dim _strUrl, _strTextField, _strFileField As String

    Dim method, contentType, host, path, _headerText, _respHtml, _referer, _cookie As String

    Public Encode As Encoding = Encoding.Default

    Dim r As RegularExpressions.Regex

    Dim m As RegularExpressions.Match

    Dim PostDataList()(), header() As Byte

    Dim _start As Boolean = True

    Dim _SendProgress, _ReceiveProgress, _SendContentLength, _ReceiveContentLength, startIndex As Integer

 

 

 

    ''' <summary>

    ''' 请求的url地址

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Property strUrl() As String

        Get

            Return _strUrl

        End Get

        Set(ByVal value As String)

            If value <> "" Then

                m = r.Match(value, "https*://([^/]+)(/(.+))?")

                If m.Success Then

                    host = m.Groups(1).Value

                    path = "/" + m.Groups(3).Value

                    _strUrl = value

                Else

                    MsgBox("URL不合法!")

                End If

            End If

        End Set

    End Property

 

    ''' <summary>

    ''' 要发送的文本域

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Property strTextField() As String

        Get

            Return _strTextField

        End Get

        Set(ByVal value As String)

            If value <> "" Then

                m = r.Match(value, "(/w+=[^&]+)|((/w+=[^&]+&)+)")

                If m.Success Then

                    _strTextField = value

                Else

                    MsgBox("数据有误:" & value)

                End If

            End If

        End Set

    End Property

 

    ''' <summary>

    ''' 要发送的文件域

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Property strFileField() As String

        Get

            Return _strFileField

        End Get

        Set(ByVal value As String)

            If value <> "" Then

                m = r.Match(value, "(/w+=[^&]+)|((/w+=[^&]+&)+)")

                If m.Success Then

                    _strFileField = value

                Else

                    MsgBox("数据有误:" & value)

                End If

            End If

        End Set

    End Property

 

    ''' <summary>

    ''' 获取或设置Cookie

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks>用来跟踪用户身份</remarks>

    Property Cookie() As String

        Get

            Return _cookie

        End Get

        Set(ByVal value As String)

            _cookie = value

        End Set

    End Property

 

    ''' <summary>

    ''' 获取或设置Referer

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks>模拟上一次访问地址</remarks>

    Property Referer() As String

        Get

            Return _referer

        End Get

        Set(ByVal value As String)

            _referer = value

        End Set

    End Property

 

    ''' <summary>

    ''' 获取http响应头文本

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks></remarks>

    ReadOnly Property headerText() As String

        Get

            Return _headerText

        End Get

    End Property

 

    ''' <summary>

    ''' 获取服务器返回的文本

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Property RespHtml() As String

        Get

            Return _respHtml

        End Get

        Set(ByVal value As String)

            _respHtml = value

        End Set

    End Property

 

    ''' <summary>

    ''' 获取发送实体大小

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks></remarks>

    ReadOnly Property SendContentLength() As Integer

        Get

            Return _SendContentLength

        End Get

    End Property

 

    ''' <summary>

    ''' 获取接收实体大小

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks></remarks>

    ReadOnly Property ReceiveContentLength() As Integer

        Get

            Return _ReceiveContentLength

        End Get

    End Property

 

    ''' <summary>

    ''' 获取数据发送进度

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks></remarks>

    ReadOnly Property SendProgress() As Integer

        Get

            Return _SendProgress

        End Get

    End Property

 

    ''' <summary>

    ''' 获取数据接收进度

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks></remarks>

    ReadOnly Property ReceiveProgress() As Integer

        Get

            Return _ReceiveProgress

        End Get

    End Property

 

    ''' <summary>

    ''' 设置是否立即中断发送和接收数据

    ''' </summary>

    ''' <value></value>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Property Start() As Boolean

        Get

            Return _start

        End Get

        Set(ByVal value As Boolean)

            _start = value

        End Set

    End Property

 

    ''' <summary>

    ''' 建立socket连接

    ''' </summary>

    ''' <param name="server"></param>

    ''' <param name="port"></param>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Private Function ConnectSocket(ByVal server As String, ByVal port As Integer) As Sockets.Socket

        Dim s As Sockets.Socket = Nothing

        Dim hostEntry As IPHostEntry = Nothing

 

        ' Get host related information.

        Try

            hostEntry = Dns.GetHostEntry(server)

 

            ' Loop through the AddressList to obtain the supported AddressFamily. This is to avoid

            ' an exception that occurs when the host host IP Address is not compatible with the address family

            ' (typical in the IPv6 case).

            Dim address As IPAddress

 

            For Each address In hostEntry.AddressList

                Dim endPoint As New IPEndPoint(address, port)

                Dim tempSocket As New Sockets.Socket(endPoint.AddressFamily, SocketType.Stream, ProtocolType.Tcp)

 

                tempSocket.Connect(endPoint)

 

                If tempSocket.Connected Then

                    s = tempSocket

                    Exit For

                End If

 

            Next address

            Return s

        Catch ex As Exception

            Return Nothing

        End Try

    End Function

 

    ''' <summary>

    ''' 发送并接收数据

    ''' </summary>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Private Function SocketSendReceive(Optional ByVal progress As Boolean = False) As Byte()

        _SendProgress = 0

        _ReceiveProgress = 0

        Dim s As Sockets.Socket = ConnectSocket(host, 80)

        If s Is Nothing Then

            Return Encode.GetBytes("无法解析主机名称")

        End If

 

        Dim i, count As Integer

        Dim receivedByte() As Byte

        '创建请求数据

        CreateRequestData()

        Try

            '发送数据****************************************

            s.SendTimeout = 5000

            s.Send(header) '发送请求头

            '如果有数据要发送就继续发送

            If Me._SendContentLength > 0 Then

                For i = 0 To PostDataList.Length - 1

                    If Not Start Then

                        s.Close()

                        Return Encode.GetBytes("中断")

                    End If

                    s.Send(PostDataList(i)) '将缓冲区的数据发送出去

                    _SendProgress += PostDataList(i).Length

                Next

                s.Shutdown(SocketShutdown.Send) '停止发送数据

            End If

 

            '接收数据*****************************************

            Do

                If Not Start Then

                    s.Close()

                    Return Encode.GetBytes("中断")

                End If

                Dim receiveBuffer(RECEIVE_BUFFER_SIZE) As Byte

                count = s.Receive(receiveBuffer)

                ReDim Preserve receiveBuffer(count - 1)

                receivedByte = UniteArr(receivedByte, receiveBuffer)

                _ReceiveProgress += count

            Loop While count > 0

 

            s.Close()

            Me._strTextField = ""

            Me._strFileField = ""

            Return GetResponseByte(receivedByte)

        Catch ex As Exception

            Return Encode.GetBytes(ex.Message)

        End Try

    End Function

 

    ''' <summary>

    ''' 分析服务器返回的字节流,去掉响应头,返回实体部分

    ''' </summary>

    ''' <param name="receivedByte"></param>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Function GetResponseByte(ByRef receivedByte() As Byte) As Byte()

        Dim tempByte() As Byte

        If Not receivedByte Is Nothing Then

            If receivedByte.Length <= 5000 Then

                GetHeaderInfo(receivedByte)

            Else

                Dim headByte(5000) As Byte

                Array.Copy(receivedByte, headByte, 5000)

                GetHeaderInfo(headByte)

            End If

            If Me._ReceiveContentLength > receivedByte.Length - startIndex Then

                ReDim tempByte(receivedByte.Length - startIndex - 1)

                Me._ReceiveContentLength = tempByte.Length

                Array.Copy(receivedByte, startIndex, tempByte, 0, tempByte.Length)

            Else

                ReDim tempByte(Me._ReceiveContentLength - 1)

                Array.Copy(receivedByte, startIndex, tempByte, 0, Me._ReceiveContentLength)

            End If

            Return tempByte

        Else

            Return Encode.GetBytes("没有数据返回")

        End If

    End Function

 

    ''' <summary>

    ''' 分析获取响应头,获取实体大小

    ''' </summary>

    ''' <param name="receiveBuffer"></param>

    ''' <remarks></remarks>

    Private Sub GetHeaderInfo(ByVal receiveBuffer() As Byte)

        Dim text As String = Encode.GetChars(receiveBuffer)

        m = r.Match(text, "(.+" + vbCrLf + ")+" + vbCrLf + "((?<len>[a-fA-F0-9]{1,20}) {0,20}" + vbCrLf + ")?")

        If m.Success Then

            If m.Groups("len").Value <> "" Then

                '某些服务器在响应头里

                Me._ReceiveContentLength = "&H" + m.Groups("len").Value

            Else

                Me._ReceiveContentLength = 500000 '如果响应头中没有实体大小,就取前500K,但这种几率很小

            End If

            startIndex = Encode.GetBytes((m.Value)).Length '实体开始的字节位置

            _headerText = m.Value '响应头

        End If

 

        '获取实体大小

        m = r.Match(text, "Content-Length:(?<len>.+)")

        If m.Success Then

            Me._ReceiveContentLength = Trim(m.Groups("len").Value)

        End If

    End Sub

 

    ''' <summary>

    ''' 向服务器请求数据并返回响应文本

    ''' </summary>

    ''' <param name="SetCookie">如果要保存cookie则为true</param>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Function Proc(Optional ByVal SetCookie As Boolean = False) As String

        _respHtml = Encode.GetChars(SocketSendReceive)

        If SetCookie And _headerText <> "" Then

            '从响应头中获取cookie

            m = r.Match(_headerText, "Set-Cookie:([^;]+)")

            Do While m.Success

                Cookie += m.Groups(1).Value + ";"

                m = m.NextMatch

            Loop

            Cookie = Trim(Cookie)

        End If

        Return _respHtml

    End Function

 

    ''' <summary>

    ''' 上传文件

    ''' </summary>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Function UploadFile() As String

        _respHtml = Encode.GetChars(SocketSendReceive)

        Return _respHtml

    End Function

 

    ''' <summary>

    ''' 下载文件

    ''' </summary>

    ''' <param name="SavePath">文件保存路径,含文件名</param>

    ''' <remarks></remarks>

    Sub DownLoadFile(ByVal SavePath As String)

        Dim receivedData() As Byte = SocketSendReceive()

        If Start Then

            Dim fs As New FileStream(SavePath, FileMode.Create)

            fs.Write(receivedData, 0, receivedData.Length)

            fs.Close()

            fs = Nothing

        End If

    End Sub

 

 

    ''' <summary>

    ''' 创建http请求数据包

    ''' </summary>

    ''' <remarks></remarks>

    Private Sub CreateRequestData()

        Dim PostData() As Byte

        If strTextField = "" And strFileField = "" Then

            '不发送任何数据

            Me.method = "GET"

            Me._SendContentLength = 0

        ElseIf strTextField <> "" And strFileField <> "" Then

            '发送文本和文件数据

            Dim strText As String = ""

            m = r.Match(_strTextField, "(/w+)=([^&]+)")

            Do While m.Success

                strText += "--" + BOUNDARY + vbCrLf

                strText += "Content-Disposition: form-data; name=""" + m.Groups(1).Value + """" + vbCrLf + vbCrLf + m.Groups(2).Value + vbCrLf

                m = m.NextMatch

            Loop

            PostData = UniteArr(Encode.GetBytes(strText), GetFileByte(_strFileField))

 

            Me.method = "POST"

            Me.contentType = "multipart/form-data; boundary=" + BOUNDARY

            Me._SendContentLength = PostData.Length

            GetPostDataList(PostData)

        ElseIf strTextField <> "" Then

            '只发送文本数据

            PostData = Encode.GetBytes(strTextField)

            Me.method = "POST"

            Me.contentType = "application/x-www-form-urlencoded"

            Me._SendContentLength = PostData.Length

            GetPostDataList(PostData)

        ElseIf strFileField <> "" Then

            '只发送文件数据

            PostData = GetFileByte(strFileField)

            Me.method = "POST"

            Me.contentType = "multipart/form-data; boundary=" + BOUNDARY

            Me._SendContentLength = PostData.Length

            GetPostDataList(PostData)

 

        End If

        header = GetHeader()

    End Sub

 

    ''' <summary>

    ''' 获取http请求头数据

    ''' </summary>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Private Function GetHeader() As Byte()

        Dim strHeader As String

        strHeader = method + " " + path + " HTTP/1.1" + vbCrLf

        strHeader += "Accept: */*" + vbCrLf

        strHeader += "Accept-Language: zh-cn" + vbCrLf

        strHeader += "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)" + vbCrLf

        strHeader += "Host: " + host + vbCrLf

        If Referer <> "" Then

            strHeader += "Referer: " + Referer + vbCrLf

        End If

        Referer = ""

        If Me._SendContentLength > 0 Then

            strHeader += "Content-Type: " + contentType + vbCrLf

            strHeader += "Content-Length: " & Me._SendContentLength & vbCrLf

            'strHeader += "Expect:100-continue" + vbCrLf

            strHeader += "Connection: Keep-Alive" + vbCrLf

        Else

            strHeader += "Connection: Close" + vbCrLf

        End If

        If Cookie <> "" Then strHeader += "Cookie: " + _cookie + vbCrLf

        strHeader += vbCrLf

 

        Return Encode.GetBytes(strHeader)

    End Function

 

 

    ''' <summary>

    ''' 获取发送文件数据

    ''' </summary>

    ''' <param name="strFileField">文件域名称及文件路径</param>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Private Function GetFileByte(ByVal strFileField As String) As Byte()

        Dim postByte() As Byte

        Dim filePath As String

        m = r.Match(strFileField, "(/w+)=([^&]+)")

        Do While m.Success

            filePath = m.Groups(2).Value

            If File.Exists(filePath) Then

                strFileField = "--" + BOUNDARY + vbCrLf

                strFileField += "Content-Disposition: form-data; name=""" + m.Groups(1).Value + """; filename=""" + filePath + """" + vbCrLf

                strFileField += "Content-Type: image/jpeg" + vbCrLf + vbCrLf

                postByte = UniteArr(postByte, Encode.GetBytes(strFileField))

 

                Dim fs As New FileStream(filePath, FileMode.Open)

                Dim br As New BinaryReader(fs)

                postByte = UniteArr(postByte, br.ReadBytes(fs.Length))

                br.Close()

                fs.Close()

 

                postByte = UniteArr(postByte, Encode.GetBytes(vbCrLf))

            Else

                MsgBox("上传文件不存在!")

            End If

            m = m.NextMatch

        Loop

        postByte = UniteArr(postByte, Encode.GetBytes("--" + BOUNDARY + "--" + vbCrLf))

        Return postByte

    End Function

 

    ''' <summary>

    ''' 将大数据包拆分成小包

    ''' </summary>

    ''' <param name="postData">要拆分的数据包</param>

    ''' <remarks></remarks>

    Private Sub GetPostDataList(ByRef postData() As Byte)

        Dim blockCount, remnant, i, p As Integer

        blockCount = postData.Length / SEND_BUFFER_SIZE '整块个数

        remnant = postData.Length Mod SEND_BUFFER_SIZE '零头

        Dim bufferList(blockCount + IIf(remnant > 0, 0, -1))() As Byte

 

        '复制整块

        For i = 0 To blockCount - 1

            ReDim bufferList(i)(SEND_BUFFER_SIZE - 1)

            System.Array.Copy(postData, p, bufferList(i), 0, SEND_BUFFER_SIZE)

            p += SEND_BUFFER_SIZE

        Next

 

        '复制零头

        If remnant > 0 Then

            ReDim bufferList(i)(remnant - 1)

            System.Array.Copy(postData, p, bufferList(i), 0, remnant)

        End If

        PostDataList = bufferList

    End Sub

 

    ''' <summary>

    ''' 合并两个字节数组

    ''' </summary>

    ''' <param name="byte1"></param>

    ''' <param name="byte2"></param>

    ''' <returns></returns>

    ''' <remarks></remarks>

    Function UniteArr(ByVal byte1() As Byte, ByVal byte2() As Byte) As Byte()

        Dim temp() As Byte

 

        If byte1 Is Nothing And byte2 Is Nothing Then

            MsgBox("两个数组不能同时为空!")

            Return Nothing

        ElseIf byte1 Is Nothing Then

            ReDim temp(byte2.Length - 1)

            Array.Copy(byte2, 0, temp, 0, byte2.Length)

        ElseIf byte2 Is Nothing Then

            ReDim temp(byte1.Length - 1)

            Array.Copy(byte1, 0, temp, 0, byte1.Length)

        Else

            ReDim temp(byte1.Length + byte2.Length - 1)

            Array.Copy(byte1, 0, temp, 0, byte1.Length)

            Array.Copy(byte2, 0, temp, byte1.Length, byte2.Length)

        End If

 

        Return temp

    End Function

End Class

 

使用TCP协议的NAT穿透技术-原理及实现(附 VB.NET实现源码)

   其实很早我就已经实现了使用TCP协议穿透NAT了,但是苦于一直没有时间,所以没有写出来,现在终于放假有一点空闲,于是写出来共享之。     一直以来,说起NAT穿透,很多人都会被告知使用UDP打...

VB.NET关于Socket分包发送的原理分析

关于Socket编程,我之前一直处于小数据传输的阶段,就像什么多人聊天之类的,这几天项目碰到了要做在线更新,就想着肯定要静静的写一个非文字信息传输的Socket程序   难点在于: ...

VB Socket编程 框架

VB Socket编程(Winsock控件创建TCP/IP客户机/服务器程序) 好东西,所以收藏      Winsock控件建立在TCP、UDP协议的基础上,完成与远程计算机的通信。即使...
  • snlei
  • snlei
  • 2013年09月03日 13:50
  • 7373

一步一步教你使用.net进行Socket通信

一步一步教你使用.net进行Socket通信 本文源代码下载 随着Web技术的发展,Socket通信逐渐被人们遗忘。然而最近Socket应用却又越来越多。尤其是中国移动,中国联通的短信网关就是基...

.net网络编程之一:Socket编程

 在.net下进行网络编程其实也相对比较简单,因为在.net类库已经提供了大量封装好的类。在.net下网络编程比较底层的类是System.Net.Sockets.Socket类,这个类提供了丰富的方法...

在VB.NET下利用Socket实现简单的字符串发送接收程序

先查看MSDN帮助系统,找到socket类,有详细的创建套接字、使用套接字侦听、使用客户端套接字的说明。打开VS.Net 2003,新建一个VB.Net工程,名称为Server。在界面上添加一个列表框...

VB.NET多线程Socket实现简单HTTP服务

Imports System.Net Imports System.Net.Sockets Imports System.Threading Module monkeyServer Privat...
  • Vizee
  • Vizee
  • 2012年12月08日 19:45
  • 3207

FTP上传下载源代码 VB.net

  • 2012年05月27日 12:40
  • 92KB
  • 下载

asp.net文件上传下载及管理的实现

using System; using System.Data; using System.Configuration; using System.Web; using System.Web....

iOS开发之结合asp.net webservice实现文件上传下载

iOS开发中会经常用到文件上传下载的功能,这篇文件将介绍一下如何结合asp.net webservice实现文件上传下载。 首先,让我们看下文件下载。 这里我们下载cnblogs上的一个z...
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:vb.net socket实现http上传下载
举报原因:
原因补充:

(最多只允许输入30个字)