|
vb实现http协议
2007-07-01 20:45
'''作者：何道德
'''网名:hedaode
'''网站:www.hedaode.cn/www.wo789.com
'''2007/07/1
'保持属性值的局部变量
Private mvarstrUrl As String '局部复制
'保持属性值的局部变量
Private mvarstrFileFiled As String '局部复制
Private mvarstrTextFiled As String '局部复制
Public Host As String
'保持属性值的局部变量
Public Function RequestData() As Byte()
Dim i As Long
Dim PostByte() As Byte '要发送的数据包
Dim headByte() As Byte '请求头域
Dim LastByte() As Byte 'multiPart/form数据包结束标记
Dim strFileByte() As Byte '文件属性
Dim fileByte() As Byte '文件体
Dim newLine() As Byte '回车换行符号
Dim strHeader As String
Dim strPostData As String
Dim boundary As String
Dim path As String
Dim textArr,fileArr,tArr,fArr
Host = Replace(strUrl,"http://","")
i = InStr(Host,"/")
If i = 0 Then
path = "/"
Else
path = Mid(Host,i,Len(Host)) '获取资源路径
End If
Host = Replace(Host,path,"") '获取主机名
boundary = "--hedaode--"
StrToByte vbCrLf,newLine
If strTextFiled = "" And strFileFiled = "" Then
'不发送任何数据
strHeader = "GET " + path + " HTTP/1.1" + vbCrLf
strHeader = strHeader + "Accept: */*" + vbCrLf
strHeader = strHeader + "Accept-Language: zh-cn" + vbCrLf
strHeader = 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 = strHeader + "Host: " + Host + vbCrLf
If Cookies <> "" Then
strHeader = strHeader + "Cookie: " + Cookies + vbCrLf
End If
strHeader = strHeader + vbCrLf
StrToByte strHeader,PostByte
RequestData = PostByte
ElseIf strTextFiled <> "" And strFileFiled = "" Then
'只发送文本数据
strHeader = "POST " + path + " HTTP/1.1" + vbCrLf
strHeader = strHeader + "Accept: */*" + vbCrLf
strHeader = 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
If Cookies <> "" Then
strHeader = strHeader + "Cookie: " + Cookies + vbCrLf
End If
strHeader = strHeader + "Host: " + Host + vbCrLf
strHeader = strHeader + "Content-Type: application/x-www-form-urlencoded" + vbCrLf
strHeader = strHeader + "Content-Length: " & strLen(strTextFiled) & vbCrLf & vbCrLf
strHeader = strHeader + strTextFiled
StrToByte strHeader,PostByte
RequestData = PostByte
ElseIf strTextFiled = "" And strFileFiled <> "" Then
'只发送文件数据
fileArr = Split(strFileFiled,"&")
For i = 0 To UBound(fileArr)
fArr = Split(fileArr(i),"=")
strPostData = "--" + boundary + vbCrLf
strPostData = strPostData + "Content-Disposition: form-data; name=""" + fArr(0) + """; filename=""" + fArr(1) + """" + vbCrLf
strPostData = strPostData + "Content-Type: image/jpeg" + vbCrLf + vbCrLf
StrToByte strPostData,PostByte
Open fArr(1) For Binary As #1
ReDim fileByte(LOF(1) - 1)
Get #1,fileByte
Close #1
PostByte = UniteArr(PostByte,fileByte)
PostByte = UniteArr(PostByte,newLine)
Next
StrToByte "--" + boundary + "--" + vbCrLf,LastByte()
PostByte = UniteArr(PostByte,LastByte)
strHeader = "POST " + path + " HTTP/1.1" + vbCrLf
strHeader = strHeader + "Accept: */*" + vbCrLf
strHeader = 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 = strHeader + "Content-Type: multipart/form-data; boundary=" + boundary + vbCrLf
strHeader = strHeader + "Content-Length: " & (UBound(PostByte) + 1) & vbCrLf
strHeader = strHeader + "Host: " + Host + vbCrLf
If Cookies <> "" Then
strHeader = strHeader + "Cookie: " + Cookies + vbCrLf
End If
strHeader = strHeader + vbCrLf
StrToByte strHeader,headByte
PostByte = UniteArr(headByte,PostByte)
RequestData = PostByte
Else
'发送文本和文件数据
textArr = Split(strTextFiled,"&")
fileArr = Split(strFileFiled,"&")
For i = 0 To UBound(textArr)
tArr = Split(textArr(i),"=")
strPostData = strPostData + "--" + boundary + vbCrLf
strPostData = strPostData + "Content-Disposition: form-data; name=""" + tArr(0) + """" + vbCrLf + vbCrLf + tArr(1) + vbCrLf
Next
StrToByte strPostData,PostByte()
For i = 0 To UBound(fileArr)
fArr = Split(fileArr(i),"=")
strPostData = "--" + boundary + vbCrLf
strPostData = strPostData + "Content-Disposition: form-data; name=""" + fArr(0) + """; filename=""" + fArr(1) + """" + vbCrLf
strPostData = strPostData + "Content-Type: image/jpeg" + vbCrLf + vbCrLf
StrToByte strPostData,strFileByte
Open fArr(1) For Binary As #1
ReDim fileByte(LOF(1) - 1)
Get #1,strFileByte)
PostByte = UniteArr(PostByte,PostByte)
RequestData = PostByte
End If
End Function
Public Property Let strTextFiled(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.strTextFiled = 5
mvarstrTextFiled = vData
End Property
Public Property Get strTextFiled() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.strTextFiled
strTextFiled = mvarstrTextFiled
End Property
Public Property Let strFileFiled(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.strFileFiled = 5
mvarstrFileFiled = vData
End Property
Public Property Get strFileFiled() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.strFileFiled
strFileFiled = mvarstrFileFiled
End Property
Public Property Let strUrl(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.strUrl = 5
mvarstrUrl = vData
End Property
Public Property Get strUrl() As String'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.strUrl strUrl = mvarstrUrlEnd Property （编辑：李大同）
【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
|
