vb实现http协议

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, , fileByte
             Close #1
       
             PostByte = UniteArr(PostByte, strFileByte)
             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
     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 = mvarstrUrl
End Property