高手请进 - 在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上面.

哪个高手知道的能否给予指导一下. 谢谢先!!!!!!
...全文
1081 30 打赏 收藏 转发到动态 举报
写回复
用AI写文章
30 条回复
切换为时间正序
请发表友善的回复…
发表回复
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
  • 打赏
  • 举报
回复
没有, 只运行到出错的地方
加载更多回复(10)
带进度条上传代码,适合学习参考资料,也可直接使用到项目. 代码片段: Private Sub Class_Initialize() Set Files = Server.CreateObject("Scripting.Dictionary") ' 上传文件集合 Set Form = Server.CreateObject("Scripting.Dictionary") ' 表单集合 UploadProgressInfo = "DoteyUploadProgressInfo" ' Application的Key MaxTotalBytes = 1 *1024 *1024 *1024 ' 默认最大1G ChunkReadSize = 64 * 1024 ' 分块大小64K CrLf = Chr(13) & Chr(10) ' 换行 Set DoteyUpload_SourceData = Server.CreateObject("ADODB.Stream") DoteyUpload_SourceData.Type = 1 ' 二进制流 DoteyUpload_SourceData.Open Version = "1.0 Beta" ' 版本 ErrMsg = "" ' 错误信息 Set Progress = New ProgressInfo End Sub ' 将文件根据其文件名统一保存在某路径下 Public Sub SaveTo(path) Upload() ' 上传 if right(path,1) <> "/" then path = path & "/" ' 遍历所有已上传文件 For Each fileItem In Files.Items fileItem.SaveAs path & fileItem.FileName Next ' 保存结束后更新进度信息 Progress.ReadyState = "complete" '上传结束 UpdateProgressInfo progressID End Sub ' 分析上传的数据,并保存到相应集合 Public Sub Upload () Dim TotalBytes, Boundary TotalBytes = Request.TotalBytes ' 总大小 If TotalBytes < 1 Then Raise("无数据传入") Exit Sub End If If TotalBytes > MaxTotalBytes Then Raise("您当前上传大小为" & TotalBytes/1000 & " K,最大允许为" & MaxTotalBytes/1024 & "K") Exit Sub End If Boundary = GetBoundary() If IsNull(Boundary) Then Raise("如果form没有包括multipart/form-data上传是无效的") Exit Sub ''如果form没有包括multipart/form-data上传是无效的 End If

28,388

社区成员

发帖
与我相关
我的任务
社区描述
ASP即Active Server Pages,是Microsoft公司开发的服务器端脚本环境。
社区管理员
  • ASP
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧