高手请进 - 在ASP中模拟form上传文件(以multipart/form-data编码)

thinkasp 2008-08-04 01:00:25
由于项目需要,须在ASP服务器1上,将每个产品的内容和图片发送到另外一个ASP服务器2
若无图片,产品数据可在服务器1上面用
XmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
这样在服务器2上面可以正常接收到产品数据.

但如果产品有图片则需要以multipart/form-data编码POST到服务器2上面.

哪个高手知道的能否给予指导一下. 谢谢先!!!!!!
...全文
888 30 打赏 收藏 举报
写回复
30 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
thinkasp 2008-08-05
在wtogether的帮助下, 在ASP内模拟POST文件和文本数据的功能终于可以使用了, 为了方便以后有同样需要的人, 我将wtogether修改后可以正常使用的代码贴在下面, 供大家参考, 再次感谢wtogether!!!

以下代码保存为SetPost.asp
<%
Public Const adTypeBinary = 1
Public Const adTypeText = 2
Public Const adLongVarBinary = 205

'字节数组转指定字符集的字符串
Public Function BytesToString(vtData, ByVal strCharset)
Dim objFile
Set objFile = Server.CreateObject("ADODB.Stream")
objFile.Type = adTypeBinary
objFile.Open
If VarType(vtData) = vbString Then
objFile.Write BinaryToBytes(vtData)
Else
objFile.Write vtData
End If
objFile.Position = 0
objFile.Type = adTypeText
objFile.Charset = strCharset
BytesToString = objFile.ReadText(-1)
objFile.Close
Set objFile = Nothing
End Function

'字节字符串转字节数组,即经过MidB/LeftB/RightB/ChrB等处理过的字符串
Public Function BinaryToBytes(vtData)
Dim rs
Dim lSize
lSize = LenB(vtData)
Set rs = Server.CreateObject("ADODB.RecordSet")
rs.Fields.Append "Content", adLongVarBinary, lSize
rs.Open
rs.AddNew
rs("Content").AppendChunk vtData
rs.Update
BinaryToBytes = rs("Content").GetChunk(lSize)
rs.Close
Set rs = Nothing
End Function

'指定字符集的字符串转字节数组
Public Function StringToBytes(ByVal strData, ByVal strCharset)
Dim objFile
Set objFile = Server.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

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

'XML Upload Class
Class XMLUploadImpl
Private xmlHttp
Private objTemp
Private strCharset, strBoundary

Private Sub Class_Initialize()
Set xmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
Set objTemp = Server.CreateObject("ADODB.Stream")
objTemp.Type = adTypeBinary
objTemp.Open
strCharset = "GBK"
strBoundary = GetBoundary()
End Sub

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

'获取自定义的表单数据分界线
Private Function GetBoundary()
Dim ret(24)
Dim table
Dim i
table = "ABCDEFGHIJKLMNOPQRSTUVWXZYabcdefghijklmnopqrstuvwxzy0123456789"
Randomize
For i = 0 To UBound(ret)
ret(i) = Mid(table, Int(Rnd() * Len(table) + 1), 1)
Next
GetBoundary = "__NextPart__ " & 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, vtValue)
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)
If VarType(vtValue) = (vbByte Or vbArray) Then
objTemp.Write vtValue
Else
objTemp.Write GetFileBinary(vtValue)
End If
End Sub

'设置multipart/form-data结束标记
Private Sub AddEnd()
Dim tmp
'tmp = Replace("\r\n--$1--\r\n", "$1", strBoundary)
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"
xmlHttp.setRequestHeader "Content-Length", objTemp.size
xmlHttp.Send objTemp
If VarType(xmlHttp.responseBody) = (vbByte Or vbArray) Then
Upload = BytesToString(xmlHttp.responseBody, strCharset)
End If
End Function
End Class
%>




在包含该文件后用以下代码调用

Dim UploadData
Set UploadData = New XMLUploadImpl
UploadData.Charset = "gb2312"
UploadData.AddForm "Test", "123456" '文本域的名称和内容
UploadData.AddFile "ImgFile", "F:\test.jpg", "image/jpg", GetFileBinary("F:\test.jpg")'图片或者其它文件
Response.Write UploadData.Upload("http://localhost/receive.asp") 'receive.asp为接收页面
Set UploadData = Nothing



再次感谢wtogether的帮助. 准备结贴. 以上代码均通过测试 (IIS6.0 WIN2003)
  • 打赏
  • 举报
回复
thinkasp 2008-08-04
我现在不知道如何在接收页面接收这些数据, 请再帮忙一下, 谢谢了!!!
  • 打赏
  • 举报
回复
wtogether 2008-08-04
有个bug,在AddEnd方法里
tmp = Replace("\r\n--$1--\r\n", "$1", strBoundary)这会产生多余的数据
改成
tmp = "\r\n--$1--\r\n"
tmp = Replace(tmp, "\r\n", vbCrLf)
tmp = Replace(tmp, "$1", strBoundary)

文件无法被打开的错误的原因是文件不存在
我给你的只是测试用的数据,你要更改成你的电脑上的文件路径
up.AddFile的最后一个参数是文件路径或者文件的字节数组
  • 打赏
  • 举报
回复
thinkasp 2008-08-04
我用了10楼(wtogether)的代码测试
现在已经通过了, 刚才忘了在服务器上面建立这些图片文件.

现在在服务器2当中,我应该如何接收这些图片和产品数据,并保存呢

我之前是用无惧无组件上传来接收的,但现在好像不行哦

wtogether若能留个QQ, 将感激不尽!!!!!!!!!!!
  • 打赏
  • 举报
回复
thinkasp 2008-08-04
我用了10楼(wtogether)的代码测试, 出现

ADODB.Stream 错误 '800a0bba'

文件无法被打开。

这个错误, 请帮忙测试一下, 谢谢!!!!!
  • 打赏
  • 举报
回复
thinkasp 2008-08-04
一个晚上睡不着啊, 醒来却发现有这么多人在帮我想办法, 谢谢你们了, 我先测试一下的代码!!

谢谢
  • 打赏
  • 举报
回复
jhwcd 2008-08-04
[Quote=引用 10 楼 wtogether 的回复:]
http://topic.csdn.net/u/20070311/21/99cc01ae-4f24-421f-933f-fb1f26a465cd.html
这里有个例子,找了好久才找到,CSDN现在找个自己以前回的帖相当的麻烦,没有在论坛里提供[在本论坛的回帖]功能,今天把它晚上了一下,支持Input和File的上传请求


VBScript code
<%@language="vbscript"%>
<%
Option Explicit

Public Const adTypeBinary = 1
Public Const adTypeText = 2
Public Const adLongVarBinary = 205

[/Quote]
用10楼的方法试试。
  • 打赏
  • 举报
回复
windwl 2008-08-04
mark 下
  • 打赏
  • 举报
回复
wtogether 2008-08-04
如果你的服务器上的上传程序是用CONTENT-TYPE服务器变量里获取分界线,那么就将
xmlHttp.setRequestHeader "Content-Type", "multipart/form-data"
改为
xmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary
  • 打赏
  • 举报
回复
wtogether 2008-08-04
http://topic.csdn.net/u/20070311/21/99cc01ae-4f24-421f-933f-fb1f26a465cd.html
这里有个例子,找了好久才找到,CSDN现在找个自己以前回的帖相当的麻烦,没有在论坛里提供[在本论坛的回帖]功能,今天把它晚上了一下,支持Input和File的上传请求


<%@language="vbscript"%>
<%
Option Explicit

Public Const adTypeBinary = 1
Public Const adTypeText = 2
Public Const adLongVarBinary = 205

'字节数组转指定字符集的字符串
Public Function BytesToString(vtData, ByVal strCharset)
Dim objFile
Set objFile = Server.CreateObject("ADODB.Stream")
objFile.Type = adTypeBinary
objFile.Open
If VarType(vtData) = vbString Then
objFile.Write BinaryToBytes(vtData)
Else
objFile.Write vtData
End If
objFile.Position = 0
objFile.Type = adTypeText
objFile.Charset = strCharset
BytesToString = objFile.ReadText(-1)
objFile.Close
Set objFile = Nothing
End Function

'字节字符串转字节数组,即经过MidB/LeftB/RightB/ChrB等处理过的字符串
Public Function BinaryToBytes(vtData)
Dim rs
Dim lSize
lSize = LenB(vtData)
Set rs = Server.CreateObject("ADODB.RecordSet")
rs.Fields.Append "Content", adLongVarBinary, lSize
rs.Open
rs.AddNew
rs("Content").AppendChunk vtData
rs.Update
BinaryToBytes = rs("Content").GetChunk(lSize)
rs.Close
Set rs = Nothing
End Function

'指定字符集的字符串转字节数组
Public Function StringToBytes(ByVal strData, ByVal strCharset)
Dim objFile
Set objFile = Server.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

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

'XML Upload Class
Class XMLUploadImpl
Private xmlHttp
Private objTemp
Private strCharset, strBoundary

Private Sub Class_Initialize()
Set xmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
Set objTemp = Server.CreateObject("ADODB.Stream")
objTemp.Type = adTypeBinary
objTemp.Open
strCharset = "GBK"
strBoundary = GetBoundary()
End Sub

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

'获取自定义的表单数据分界线
Private Function GetBoundary()
Dim ret(24)
Dim table
Dim i
table = "ABCDEFGHIJKLMNOPQRSTUVWXZYabcdefghijklmnopqrstuvwxzy0123456789"
Randomize
For i = 0 To UBound(ret)
ret(i) = Mid(table, Int(Rnd() * Len(table) + 1), 1)
Next
GetBoundary = "__NextPart__ " & 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, vtValue)
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)
If VarType(vtValue) = (vbByte Or vbArray) Then
objTemp.Write vtValue
Else
objTemp.Write GetFileBinary(vtValue)
End If
End Sub

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

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

Dim up, ret
Set up = New XMLUploadImpl
up.Charset = "utf-8"
up.AddForm "name", "张三"
up.AddForm "intro", "上传测试"
'下两行代码设置的是文件路径
up.AddFile "file", "E:\images\01.gif", "image/gif", "E:\images\01.gif"
up.AddFile "file", "E:\images\01.png", "image/png", "E:\images\01.png"
'下两行代码设置的是文件的字节数组
up.AddFile "file", "E:\images\01.jpg", "image/jpg", GetFileBinary("E:\images\01.jpg")
up.AddFile "file", "E:\images\01.bmp", "image/bmp", GetFileBinary("E:\images\01.bmp")
ret = up.Upload("http://localhost/test.asp?name=hello")
Set up = Nothing

Response.Write ret
%>
  • 打赏
  • 举报
回复
thinkasp 2008-08-04
不是的, 不能只传地址信息, 必须要把图片文件传过去的,
而且是在两个服务器之间的传输, 不是在客户端的, 所以请大家不要用iframe, input javascript来寻求解决,

谢谢.
  • 打赏
  • 举报
回复
chenguang79 2008-08-04
楼主的意思是不是就是在上传的时候,要在服务器1和服务器2上都存一下图片和信息啊
其实楼主不用这么麻烦。只在服务器1上存一下图片,然后将图片的地址做为信息存入服务器2不就行了吗。你这样方便而且简单
  • 打赏
  • 举报
回复
chenguang79 2008-08-04
楼主的意思是不是就是在上传的时候,要在服务器1和服务器2上都存一下图片和信息啊
其实楼主不用这么麻烦。只在服务器1上存一下图片,然后将图片的地址做为信息存入服务器2不就行了吗。你这样方便而且简单
  • 打赏
  • 举报
回复
thinkasp 2008-08-04
图片文件不会大, 不需要断点继传的, 只要能实现这个功能即可.

代码大概如下:

AllPostData="Test=123"
Set XmlHttp = Server.CreateObject(""Microsoft.XMLHTTP)
XmlHttp.Open "POST","http://server2/receive.asp",False
XmlHttp.setRequestHeader "Content-Type", "multipart/form-data"
XmlHttp.Send AllPostData
PostDataToMainSite=XmlHttp.ResponseText
Set XmlHttp = Nothing

请高手过目, 并指点, 谢谢
  • 打赏
  • 举报
回复
jspadmin 2008-08-04
POST文件?
关注
  • 打赏
  • 举报
回复
pzhuyy 2008-08-04
  • 打赏
  • 举报
回复
pzhuyy 2008-08-04
这样上传是可以的,但如果图片较大,或者需要断点续传之类就会比较头痛.

用ftp上传,在asp服务器1下载asp服务器2的数据.
  • 打赏
  • 举报
回复
thinkasp 2008-08-04
您好wtogether, 不知道您的姓名, 只能这样称呼了^_^

现在可以正常收到文本数据, 我在测试一下图片数据的接收.
  • 打赏
  • 举报
回复
wtogether 2008-08-04
那加个判断,fs.Upload方法里
Upload = BytesToString(xmlHttp.responseBody, strCharset)
改成
If VarType(xmlHttp.responseBody) = (vbByte Or vbArray) Then
Upload = BytesToString(xmlHttp.responseBody, strCharset)
End If
  • 打赏
  • 举报
回复
thinkasp 2008-08-04
没有, 只运行到出错的地方
  • 打赏
  • 举报
回复
加载更多回复
相关推荐
发帖
ASP
加入

2.8w+

社区成员

ASP即Active Server Pages,是Microsoft公司开发的服务器端脚本环境。
申请成为版主
帖子事件
创建了帖子
2008-08-04 01:00
社区公告
暂无公告