asp如何同步图片到新浪微博 API接口statuses/upload


asp如何在自己网站上传图片到新浪微博
新浪微博提供的借口说明http://open.weibo.com/wiki/2/statuses/upload
我的代码
dim p_status,p_token,canshu,p_pic
p_pic=request.BinaryRead((request.totalbytes))

oauth_token="access_token=2.00mw8QyBmd_MvBdf92cdd85f_7tutB"
oauth_status="&status=上传图片并发布1条微博"
oauth_pic="&pic="&p_pic

canshu=oauth_token& "&" &oauth_status& "&" &oauth_pic

set http=server.createobject("msxml2.xmlhttp")

http.open "post","https://upload.api.weibo.com/2/statuses/upload.json",false

http.setRequestHeader "Content-Type", "multipart/form-data;"

http.send(canshu)

response.Write(http.responsetext)

set http=nothing

oauth_pic="&pic="&p_pic 提示类型不匹配
要如何把图片通过自己网站提交到新浪微博啊?

文件上传 Oauth2.0

lsjsf 10 years, 7 months ago

oauth_pic="&pic="&p_pic 提示类型不匹配
这是因为字符串和二进制数据不能直接拼接到一起,数据类型不同,XMLHTTP POST当中如果需要上传图片或文件,需要借助Adodb.stream读取文件(图片)二进制数据来进行提交,如果需要提交额外的参数值,需要把参数也一同封装在二进制数据包中,简单说,创建一个Adodb.stream对象,把需要提交的参数和文件一并放到里边,用到该对象的write方法,提交的时候提交一整个adodb.stream对象,当然了,参数和参数之间需要用适当的表单分隔线来隔开。
下面是一个XMLHTTP上传类的代码,参考里边的代码,都很精炼,很规范

   
  'XML Upload Class
  
Class XMLUpload
Private xmlHttp
Private objTemp
Private adTypeBinary, adTypeText
Private strCharset, strBoundary

Private Sub Class_Initialize()
adTypeBinary = 1
adTypeText = 2
Set xmlHttp = CreateObject("Msxml2.XMLHTTP")
Set objTemp = CreateObject("ADODB.Stream")
objTemp.Type = adTypeBinary
objTemp.Open
strCharset = "utf-8"
strBoundary = GetBoundary()
End Sub

Private Sub Class_Terminate()
objTemp.Close
Set objTemp = Nothing
Set xmlHttp = Nothing
End Sub

'指定字符集的字符串转字节数组
Public Function StringToBytes(ByVal strData, ByVal strCharset)
Dim objFile
Set objFile = CreateObject("ADODB.Stream")
objFile.Type = adTypeText
objFile.Charset = strCharset
objFile.Open
objFile.WriteText strData
objFile.Position = 0
objFile.Type = adTypeBinary
If UCase(strCharset) = "UNICODE" Then
objFile.Position = 2 'delete UNICODE BOM
ElseIf UCase(strCharset) = "UTF-8" Then
objFile.Position = 3 'delete UTF-8 BOM
End If
StringToBytes = objFile.Read(-1)
objFile.Close
Set objFile = Nothing
End Function

'获取文件内容的字节数组
Private Function GetFileBinary(ByVal strPath)
Dim objFile
Set objFile = CreateObject("ADODB.Stream")
objFile.Type = adTypeBinary
objFile.Open
objFile.LoadFromFile strPath
GetFileBinary = objFile.Read(-1)
objFile.Close
Set objFile = Nothing
End Function

'获取自定义的表单数据分界线
Private Function GetBoundary()
Dim ret(12)
Dim table
Dim i
table = "abcdefghijklmnopqrstuvwxzy0123456789"
Randomize
For i = 0 To UBound(ret)
ret(i) = Mid(table, Int(Rnd() * Len(table) + 1), 1)
Next
GetBoundary = "---------------------------" & Join(ret, Empty)
End Function

'设置上传使用的字符集
Public Property Let Charset(ByVal strValue)
strCharset = strValue
End Property

'添加文本域的名称和值
Public Sub AddForm(ByVal strName, ByVal strValue)
Dim tmp
tmp = "\r\n--$1\r\nContent-Disposition: form-data; name=""$2""\r\n\r\n$3"
tmp = Replace(tmp, "\r\n", vbCrLf)
tmp = Replace(tmp, "$1", strBoundary)
tmp = Replace(tmp, "$2", strName)
tmp = Replace(tmp, "$3", strValue)
objTemp.Write StringToBytes(tmp, strCharset)
End Sub

'设置文件域的名称/文件名称/文件MIME类型/文件路径或文件字节数组
Public Sub AddFile(ByVal strName, ByVal strFileName, ByVal strFileType, ByVal strFilePath)
Dim tmp
tmp = "\r\n--$1\r\nContent-Disposition: form-data; name=""$2""; filename=""$3""\r\nContent-Type: $4\r\n\r\n"
tmp = Replace(tmp, "\r\n", vbCrLf)
tmp = Replace(tmp, "$1", strBoundary)
tmp = Replace(tmp, "$2", strName)
tmp = Replace(tmp, "$3", strFileName)
tmp = Replace(tmp, "$4", strFileType)
objTemp.Write StringToBytes(tmp, strCharset)
objTemp.Write GetFileBinary(strFilePath)
End Sub

'设置multipart/form-data结束标记
Private Sub AddEnd()
Dim tmp
tmp = "\r\n--$1--\r\n"
tmp = Replace(tmp, "\r\n", vbCrLf)
tmp = Replace(tmp, "$1", strBoundary)
objTemp.Write StringToBytes(tmp, strCharset)
objTemp.Position = 2
End Sub

'上传到指定的URL,并返回服务器应答
Public Function Upload(ByVal strURL)
Call AddEnd
xmlHttp.Open "POST", strURL, False
xmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary
'xmlHttp.setRequestHeader "Content-Length", objTemp.size
xmlHttp.Send objTemp
Upload = xmlHttp.responseText
End Function
End Class

Dim UploadData
Set UploadData = New XMLUpload
UploadData.Charset = "utf-8"
UploadData.AddForm "content", "Hello world" '文本域的名称和内容
UploadData.AddFile "file", "test.jpg", "image/jpg", "E:\wamp\www\cms\openclient\test.jpg"
WScript.Echo UploadData.Upload("http://127.0.0.1/cms/openclient/Save.php")
Set UploadData = Nothing

哇好大一条狗 answered 10 years, 7 months ago

Your Answer