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