vb.net socket实现http上传下载
Imports System
Imports System.Text
Imports System.IO
Imports System.Net
Imports System.Net.Sockets
Imports Microsoft.VisualBasic
'''
''' 实现向web发送和接收数据的类
'''
'''
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
'''
''' 请求的url地址
'''
'''
'''
'''
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
'''
''' 要发送的文本域
'''
'''
'''
'''
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
'''
''' 要发送的文件域
'''
'''
'''
'''
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
'''
''' 获取或设置Cookie
'''
'''
'''
'''
Property Cookie() As String
Get
Return _cookie
End Get
Set(ByVal value As String)
_cookie = value
End Set
End Property
'''
''' 获取或设置Referer
'''
'''
'''
'''
Property Referer() As String
Get
Return _referer
End Get
Set(ByVal value As String)
_referer = value
End Set
End Property
'''
''' 获取http响应头文本
'''
'''
'''
'''
ReadOnly Property headerText() As String
Get
Return _headerText
End Get
End Property
'''
''' 获取服务器返回的文本
'''
'''
'''
'''
Property RespHtml() As String
Get
Return _respHtml
End Get
Set(ByVal value As String)
_respHtml = value
End Set
End Property
'''
''' 获取发送实体大小
'''
'''
'''
'''
ReadOnly Property SendContentLength() As Integer
Get
Return _SendContentLength
End Get
End Property
'''
''' 获取接收实体大小
'''
'''
'''
'''
ReadOnly Property ReceiveContentLength() As Integer
Get
Return _ReceiveContentLength
End Get
End Property
'''
''' 获取数据发送进度
'''
'''
'''
'''
ReadOnly Property SendProgress() As Integer
Get
Return _SendProgress
End Get
End Property
'''
''' 获取数据接收进度
'''
'''
'''
'''
ReadOnly Property ReceiveProgress() As Integer
Get
Return _ReceiveProgress
End Get
End Property
'''
''' 设置是否立即中断发送和接收数据
'''
'''
'''
'''
Property Start() As Boolean
Get
Return _start
End Get
Set(ByVal value As Boolean)
_start = value
End Set
End Property
'''
''' 建立socket连接
'''
'''
'''
'''
'''
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
'''
''' 发送并接收数据
'''
'''
'''
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
'''
''' 分析服务器返回的字节流，去掉响应头，返回实体部分
'''
'''
'''
'''
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
'''
''' 分析获取响应头，获取实体大小
'''
'''
'''
Private Sub GetHeaderInfo(ByVal receiveBuffer() As Byte)
Dim text As String = Encode.GetChars(receiveBuffer)
m = r.Match(text, "(.+" + vbCrLf + ")+" + 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:(?
If m.Success Then
Me._ReceiveContentLength = Trim(m.Groups("len").Value)
End If
End Sub
'''
''' 向服务器请求数据并返回响应文本
'''
''' 如果要保存cookie则为true
'''
'''
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
'''
''' 上传文件
'''
'''
'''
Function UploadFile() As String
_respHtml = Encode.GetChars(SocketSendReceive)
Return _respHtml
End Function
'''
''' 下载文件
'''
''' 文件保存路径，含文件名
'''
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
'''
''' 创建http请求数据包
'''
'''
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
'''
''' 获取http请求头数据
'''
'''
'''
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
'''
''' 获取发送文件数据
'''
''' 文件域名称及文件路径
'''
'''
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
'''
''' 将大数据包拆分成小包
'''
''' 要拆分的数据包
'''
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
'''
''' 合并两个字节数组
'''
'''
'''
'''
'''
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