双11狂欢大促

盲盒赢 定制羽绒服

开启惊喜盲盒，抽取你的专属好礼

— 惊喜奖品抢先看 —

超级年卡50元券

周边70元券

手机支架

一拖三数据线

雨伞

运动毛巾

电动牙刷

VIP月卡

机械键盘

定制羽绒服

超级年卡50元券

周边70元券

手机支架

一拖三数据线

雨伞

运动毛巾

电动牙刷

VIP月卡

机械键盘

定制羽绒服

怎样用asp实现多张图片同时上传并读取????

2007-11-21 04:08:28 595 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

jiaxinhu517 墨衍会员 · AI 创作全网分发关注 + 加入社区

ASP.NET MVC +Layui 实现图片上传功能 ASP.NET MVC +Layui 实现图片上传功能这是一个前端的添加功能只展示图片添加的前端代码 <div class="layui-upload"> <button type="button" class="layui-btn" id="ImgUrlbtn" style="float:left;"> <font color="red"></font>请选择图片 </button> <div class="layui-uploa 阅读详情

我的上传界面是:

<html>
<head>
<title>普通多文件上传 </title>
</head>
<body>
<form method="post" action="uptodir.asp" enctype="multipart/form-data">
<p>上传图片一:<input type="file" name="File1"></p>
<p>上传图片二:<input type="file" name="File2"></p>
<p>上传图片三:<input type="file" name="File3"></p>
<input type="submit" value="上传">

</form>
</body>
</html>
我的处理界面是:uptodir.asp

<%
Server.ScriptTimeout =20*60 '上传超时时间20分钟
dim userfilepath,userfilepath1,userfilepath2
formPath = "UploadFiles/"

Set upload= New DoteyUpload

Upload.SaveTo(formPath) '将文件根据其文件名统一保存在某路径下

If upload.ErrMsg = "" then
Response.Write ("form传递来的数据:<BR>")
For each formName in upload.Form ''列出所有form数据
Response.write formName & "=" & upload.Form(formName) & "<br>"
temp=temp & "||" & upload.Form(formName) '用字符串存表单所有变量
next
temp2=split(temp,"||") '将字符串拆开存入数组
userfilepath=temp2(1) '取出数组元素
userfilepath1=temp2(2)
userfilepath2=temp2(3)

Response.Write ("<BR><BR>已经成功上传文件:<BR>")
For Each formName In upload.Files ''列出所有上传了的文件
Set file = upload.Files(formName) ''生成一个文件对象
Set file1 = upload.Files(formName) ''生成一个文件对象
Set file2 = upload.Files(formName) ''生成一个文件对象
userfilepath=formPath & File.FileName
userfilepath1=formPath & File1.FileName
userfilepath2=formPath & File2.FileName
response.write "<a target=_blank href='" & formPath & File.FileName & "'>" & formPath & File.FileName & "下载此文件" & "</a> 成功!<br>"
response.write "<br /><BR>"
Set file=nothing
Next
Else
Response.Write("上传过程中出现错误:<br>" & Upload.ErrMsg)
End If

Set upload=nothing

response.write "<hr>"
response.write "文件保存路径：" & userfilepath
response.write "文件保存路径：" & userfilepath1
response.write "文件保存路径：" & userfilepath2
'开始写入数据库
set rs=server.createobject("adodb.recordset")
SQL="select * from uploadfiles where id is null"
rs.open SQL,conn,1,3
rs.addnew
rs("userfilepath")=userfilepath
rs("userfilepath1")=userfilepath1
rs("userfilepath2")=userfilepath2
rs.Update
rsclose()
connclose()
response.write "<br><br><br>写入数据库完毕!"

%>
<BR><A HREF="showuserfiles.asp">查看所有用户上传记录</A>
为什么我存入三个的路径到数据库中的时候,最后一张的路径会覆盖前面二个的路径?????

...全文

ASP.Net将图片以二进制方式存入数据库，并读取今天研究了一下如何将图片已二进制形式存入数据库，然后再从中读取显示在页面上。下面我会贴出一些关键代码。 1.将图片存入数据库前台代码：后台代码：需要的命名空间using System.Data.SqlClient; using System.Drawing; using System.IO; /// /// 添加人员信息 /// / 阅读详情

jiaxinhu517

ASP 28,401 成员 356,940 内容

+ 关注 + 加入社区

切换为时间正序

LOVEYOULOVE 2007-12-09

打赏
举报

' 总大小
Public Property Get TotalSize
TotalSize = FormatNumber(TotalBytes / 1024, 0, 0, 0, -1) & " K"
End Property

' 已上传大小
Public Property Get SizeCompleted
SizeCompleted = FormatNumber(UploadedBytes / 1024, 0, 0, 0, -1) & " K"
End Property

' 已上传秒数
Public Property Get ElapsedSeconds
ElapsedSeconds = DateDiff("s", StartTime, Now())
End Property

' 已上传时间
Public Property Get ElapsedTime
If ElapsedSeconds > 3600 then
ElapsedTime = ElapsedSeconds \ 3600 & " 时 " & (ElapsedSeconds mod 3600) \ 60 & " 分 " & ElapsedSeconds mod 60 & " 秒"
ElseIf ElapsedSeconds > 60 then
ElapsedTime = ElapsedSeconds \ 60 & " 分 " & ElapsedSeconds mod 60 & " 秒"
else
ElapsedTime = ElapsedSeconds mod 60 & " 秒"
End If
End Property

' 传输速率
Public Property Get TransferRate
If ElapsedSeconds > 0 Then
TransferRate = FormatNumber(UploadedBytes / 1024 / ElapsedSeconds, 2, 0, 0, -1) & " K/秒"
Else
TransferRate = "0 K/秒"
End If
End Property

' 完成百分比
Public Property Get Percentage
If TotalBytes > 0 Then
Percentage = fix(UploadedBytes / TotalBytes * 100) & "%"
Else
Percentage = "0%"
End If
End Property

' 估计剩余时间
Public Property Get TimeLeft
If UploadedBytes > 0 Then
SecondsLeft = fix(ElapsedSeconds * (TotalBytes / UploadedBytes - 1))
If SecondsLeft > 3600 then
TimeLeft = SecondsLeft \ 3600 & " 时 " & (SecondsLeft mod 3600) \ 60 & " 分 " & SecondsLeft mod 60 & " 秒"
ElseIf SecondsLeft > 60 then
TimeLeft = SecondsLeft \ 60 & " 分 " & SecondsLeft mod 60 & " 秒"
else
TimeLeft = SecondsLeft mod 60 & " 秒"
End If
Else
TimeLeft = "未知"
End If
End Property

End Class

'---------------------------------------------------
' 文件信息类
'---------------------------------------------------
Class FileInfo

Dim FormName, FileName, FilePath, FileSize, FileType, FileStart, FileExt, NewFileName

Private Sub Class_Initialize
FileName = "" ' 文件名
FilePath = "" ' 客户端路径
FileSize = 0 ' 文件大小
FileStart= 0 ' 文件开始位置
FormName = "" ' 表单名
FileType = "" ' 文件Content Type
FileExt = "" ' 文件扩展名
NewFileName = "" '上传后文件名
End Sub

Public Function Save()
SaveAs(FileName)
End Function

' 保存文件
Public Function SaveAs(fullpath)
Dim dr
SaveAs = false
If trim(fullpath) = "" Or FileStart = 0 Or FileName = "" Or right(fullpath,1) = "/" Then Exit Function

NewFileName = GetFileNameByPath(fullpath)

Set dr = CreateObject("Adodb.Stream")
dr.Mode = 3
dr.Type = 1
dr.Open
DoteyUpload_SourceData.position = FileStart
DoteyUpload_SourceData.copyto dr, FileSize
dr.SaveToFile MapPath(FullPath), 2
dr.Close
set dr = nothing
SaveAs = true
End function

' 返回Binary
Public Function GetBinary()
Dim Binary
If FileStart = 0 Then Exit Function

DoteyUpload_SourceData.Position = FileStart
Binary = DoteyUpload_SourceData.Read(FileSize)

GetBinary = Binary
End function

' 取服务器端路径
Private Function MapPath(Path)
If InStr(1, Path, ":") > 0 Or Left(Path, 2) = "\\" Then
MapPath = Path
Else
MapPath = Server.MapPath(Path)
End If
End function

'根据路径获取文件名
Private Function GetFileNameByPath(FullPath)
Dim pos
pos = 0
FullPath = Replace(FullPath, "/", "\")
pos = InStrRev(FullPath, "\") + 1
If (pos > 0) Then
GetFileNameByPath = Mid(FullPath, pos)
Else
GetFileNameByPath = FullPath
End If
End Function

End Class

%>

这样就可以了

LOVEYOULOVE 2007-12-09

打赏
举报

'表单数据
Else
' 允许同名表单
If Form.Exists(FieldName) Then
Form(FieldName) = Form(FieldName) & "," & BinaryToString(bFieldContent)
Else
Form.Add FieldName, BinaryToString(bFieldContent)
End If
End If

' 是否结束位置
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, BoundaryEnd + LenB(Boundary), 2))
IsBoundaryEnd = TwoCharsAfterEndBoundary = "--"

If Not IsBoundaryEnd Then ' 如果不是结尾, 继续读取下一块
BoundaryStart = BoundaryEnd
BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary)
End If
Loop

' 解析文件结束后更新进度信息
Progress.UploadedBytes = TotalBytes
Progress.ReadyState = "interactive" '解析文件结束
UpdateProgressInfo progressID

End Sub

'异常信息
Private Sub Raise(Message)
ErrMsg = ErrMsg & "[" & Now & "]" & Message & "<BR>"

Progress.ErrorMessage = Message
UpdateProgressInfo ProgressID

'call Err.Raise(vbObjectError, "DoteyUpload", Message)

End Sub

' 取边界值
Private Function GetBoundary()
Dim ContentType, ctArray, bArray
ContentType = Request.ServerVariables("HTTP_CONTENT_TYPE")
ctArray = Split(ContentType, ";")
If Trim(ctArray(0)) = "multipart/form-data" Then
bArray = Split(Trim(ctArray(1)), "=")
GetBoundary = "--" & Trim(bArray(1))
Else '如果form中没有包括multipart/form-data上传是无效的
GetBoundary = null
Raise("如果form中没有包括multipart/form-data上传是无效的")
End If
End Function

' 将二进制流转化成文本
Private Function BinaryToString(xBinary)
Dim Binary
if vartype(xBinary) = 8 then Binary = MultiByteToBinary(xBinary) else Binary = xBinary

Dim RS, LBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)

if LBinary>0 then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
BinaryToString = RS("mBinary")
Else
BinaryToString = ""
End If
End Function

Function MultiByteToBinary(MultiByte)
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
if LMultiByte>0 then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function

' 字符串到二进制
Function StringToBinary(String)
Dim I, B
For I=1 to len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Next
StringToBinary = B
End Function

'返回表单名
Private Function GetFieldName(infoStr)
Dim sPos, EndPos
sPos = InStr(infoStr, "name=")
EndPos = InStr(sPos + 6, infoStr, Chr(34) & ";")
If EndPos = 0 Then
EndPos = inStr(sPos + 6, infoStr, Chr(34))
End If
GetFieldName = Mid(infoStr, sPos + 6, endPos - _
(sPos + 6))
End Function

'返回文件名
Private Function GetFileName(infoStr)
Dim sPos, EndPos
sPos = InStr(infoStr, "filename=")
EndPos = InStr(infoStr, Chr(34) & CrLf)
GetFileName = Mid(infoStr, sPos + 10, EndPos - _
(sPos + 10))
End Function

'返回文件的 MIME type
Private Function GetFileType(infoStr)
sPos = InStr(infoStr, "Content-Type: ")
GetFileType = Mid(infoStr, sPos + 14)
End Function

'根据路径获取文件名
Private Function GetFileNameByPath(FullPath)
Dim pos
pos = 0
FullPath = Replace(FullPath, "/", "\")
pos = InStrRev(FullPath, "\") + 1
If (pos > 0) Then
GetFileNameByPath = Mid(FullPath, pos)
Else
GetFileNameByPath = FullPath
End If
End Function

'根据路径获取扩展名
Private Function GetFileExt(FullPath)
Dim pos
pos = InStrRev(FullPath,".")
if pos>0 then GetFileExt = Mid(FullPath, Pos)
End Function

' 更新进度信息
' 进度信息保存在Application中的ADODB.Recordset对象中
Private Sub UpdateProgressInfo(progressID)
Const adTypeText = 2, adDate = 7, adUnsignedInt = 19, adVarChar = 200

If (progressID <> "" And IsNumeric(progressID)) Then
Application.Lock()
if IsEmpty(Application(UploadProgressInfo)) Then
Set Info = Server.CreateObject("ADODB.Recordset")
Set Application(UploadProgressInfo) = Info
Info.Fields.Append "ProgressID", adUnsignedInt
Info.Fields.Append "StartTime", adDate
Info.Fields.Append "LastActivity", adDate
Info.Fields.Append "TotalBytes", adUnsignedInt
Info.Fields.Append "UploadedBytes", adUnsignedInt
Info.Fields.Append "ReadyState", adVarChar, 128
Info.Fields.Append "ErrorMessage", adVarChar, 4000
Info.Open
Info("ProgressID").Properties("Optimize") = true
Info.AddNew
Else
Set Info = Application(UploadProgressInfo)
If Not Info.Eof Then
Info.MoveFirst()
Info.Find "ProgressID = " & progressID
End If
If (Info.EOF) Then
Info.AddNew
End If
End If

Info("ProgressID") = clng(progressID)
Info("StartTime") = Progress.StartTime
Info("LastActivity") = Now()
Info("TotalBytes") = Progress.TotalBytes
Info("UploadedBytes") = Progress.UploadedBytes
Info("ReadyState") = Progress.ReadyState
Info("ErrorMessage") = Progress.ErrorMessage
Info.Update

Application.UnLock
End IF
End Sub

' 根据上传ID获取进度信息
Public Function GetProgressInfo(progressID)

Dim pi, Infos
Set pi = New ProgressInfo
If Not IsEmpty(Application(UploadProgressInfo)) Then
Set Infos = Application(UploadProgressInfo)
If Not Infos.Eof Then
Infos.MoveFirst
Infos.Find "ProgressID = " & progressID
If Not Infos.EOF Then
pi.StartTime = Infos("StartTime")
pi.LastActivity = Infos("LastActivity")
pi.TotalBytes = clng(Infos("TotalBytes"))
pi.UploadedBytes = clng(Infos("UploadedBytes"))
pi.ReadyState = Trim(Infos("ReadyState"))
pi.ErrorMessage = Trim(Infos("ErrorMessage"))
Set GetProgressInfo = pi
End If
End If
End If
Set GetProgressInfo = pi
End Function

' 移除指定的进度信息
Private Sub RemoveProgressInfo(progressID)
If Not IsEmpty(Application(UploadProgressInfo)) Then
Application.Lock
Set Info = Application(UploadProgressInfo)
If Not Info.Eof Then
Info.MoveFirst
Info.Find "ProgressID = " & progressID
If Not Info.EOF Then
Info.Delete
End If
End If

' 如果没有记录了, 直接释放, 避免'800a0bcd'错误
If Info.RecordCount = 0 Then
Info.Close
Application.Contents.Remove UploadProgressInfo
End If
Application.UnLock
End If
End Sub

' 移除指定的进度信息
Private Sub RemoveOldProgressInfo(progressID)
If Not IsEmpty(Application(UploadProgressInfo)) Then
Dim L
Application.Lock

Set Info = Application(UploadProgressInfo)
Info.MoveFirst

Do
L = Info("LastActivity").Value
If IsEmpty(L) Then
Info.Delete()
ElseIf DateDiff("d", Now(), L) > 30 Then
Info.Delete()
End If
Info.MoveNext()
Loop Until Info.EOF

' 如果没有记录了, 直接释放, 避免'800a0bcd'错误
If Info.RecordCount = 0 Then
Info.Close
Application.Contents.Remove UploadProgressInfo
End If
Application.UnLock
End If
End Sub

End Class

'---------------------------------------------------
' 进度信息类
'---------------------------------------------------
Class ProgressInfo

Public UploadedBytes
Public TotalBytes
Public StartTime
Public LastActivity
Public ReadyState
Public ErrorMessage

Private Sub Class_Initialize()
UploadedBytes = 0 ' 已上传大小
TotalBytes = 0 ' 总大小
StartTime = Now() ' 开始时间
LastActivity = Now() ' 最后更新时间
ReadyState = "uninitialized" ' uninitialized,loading,loaded,interactive,complete
ErrorMessage = ""
End Sub

LOVEYOULOVE 2007-12-09

打赏
举报

这是我的:uptodir.asp

<!-- #include file="Upload1.asp" -->

<!-- #include file="conn1.asp" -->

<%

Server.ScriptTimeout =20*60 '上传超时时间20分钟

dim userfilepath,userfilepath1,userfilepath2

formPath = "UploadFiles/"



Set upload= New DoteyUpload



Upload.SaveTo(formPath) '将文件根据其文件名统一保存在某路径下



If upload.ErrMsg = "" then

    Response.Write ("form传递来的数据:<BR>")

	    For each formName in upload.Form ''列出所有form数据

		

		temp=temp & "||" & upload.Form(formName)  '用字符串存表单所有变量

	    next

	    temp2=split(temp,"||") '将字符串拆开存入数组

	    username=temp2(1) 

	    name=temp2(2) 

	    sex=temp2(3)

	    postcode=temp2(4) 

	    mailaddress=temp2(5) 

	    accountaddress=temp2(6)

	    vocational=temp2(7) 

	    position=temp2(8) 

	    homephone=temp2(9)

	    email=temp2(10)  

	    telephone=temp2(11) 

	    fax=temp2(12)

	    mobile=temp2(13)  

	    cardnumber=temp2(14)

	    bankaccount=temp2(15) 

	    reservebankaccount=temp2(16)	    

	    reservenote=temp2(17) 	    

i=1

	Response.Write ("<BR><BR>已经成功上传文件:<BR>")

		set rs=server.createobject("adodb.recordset")

		For Each formName In upload.Files ''列出所有上传了的文件

		Set file = upload.Files(formName)  ''生成一个文件对象

		userfilepath=formPath  & File.FileName

		

		

'判断		

		select case i

		case 1 

              rs.open "submit",conn,1,3

              rs.addnew

              rs("username")=username

              rs("name")=name

              rs("sex")=sex

              rs("postcode")=postcode

              rs("mailaddress")=mailaddress

              rs("accountaddress")=accountaddress

              rs("vocational")=vocational

              rs("position")=position

              rs("homephone")=homephone

              rs("email")=email

              rs("telephone")=telephone

              rs("fax")=fax

              rs("mobile")=mobile

              rs("cardnumber")=cardnumber

              rs("bankaccount")=bankaccount

              rs("reservebankaccount")=reservebankaccount

              rs("reservenote")=reservenote

              rs("ddate")=now()

		      rs("userfilepath").value=userfilepath        

			  response.write "<hr>"

              rs.update

              rs.close		

			  

              SQL="select top 1 id from submit ORDER BY ID DESC"

              rs.open SQL,conn,1,3

			  MaxID = rs("ID")

			  			  rs.close



		case 2 

	          sql="select * from submit where id="&MaxID

              rs.open sql,conn,1,3

		      rs("userfilepath1").value=userfilepath 

			  response.write "<hr>"

              rs.update

              rs.close		



        case 3 

	          sql="select * from submit where id="&MaxID

              rs.open sql,conn,1,3

		      rs("userfilepath2").value=userfilepath 

			  response.write "<hr>"

              rs.update

              rs.close		



		case 4 

	          sql="select * from submit where id="&MaxID

              rs.open sql,conn,1,3

		      rs("userfilepath3").value=userfilepath

		      response.write "<hr>"

              rs.update

              rs.close		



        case 5 

	          sql="select * from submit where id="&MaxID

              rs.open sql,conn,1,3

		      rs("userfilepath4").value=userfilepath

			  response.write "<hr>"

              rs.update

              rs.close	

		end select

        i=i+1

	Next

Else

	Response.Write("上传过程中出现错误:<br>" & Upload.ErrMsg)

End If

Set file=nothing

Set upload=nothing



conn.close()



%><style type="text/css">

<!--

body {

	background-color: #00CCCC;

}

-->

</style>

上传组件upload1.asp

[code=C#]<%



Dim DoteyUpload_SourceData



Class DoteyUpload

	

	Public Files

	Public Form

	Public MaxTotalBytes

	Public Version

	Public ProgressID

	Public ErrMsg

	

	Private BytesRead

	Private ChunkReadSize

	Private Info

	Private Progress



	Private UploadProgressInfo

	Private CrLf



	Private Sub Class_Initialize()

		Set Files = Server.CreateObject("Scripting.Dictionary")	' 上传文件集合

		Set Form = Server.CreateObject("Scripting.Dictionary")	' 表单集合

		UploadProgressInfo = "DoteyUploadProgressInfo"  ' Application的Key

		MaxTotalBytes = 1 *1024 *1500 ' 默认最大1500K

		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

		Boundary = StringToBinary(Boundary)

		

		Progress.ReadyState = "loading" '开始上传

		Progress.TotalBytes = TotalBytes

		UpdateProgressInfo progressID



		Dim DataPart, PartSize

		BytesRead = 0



		'循环分块读取

		Do While BytesRead < TotalBytes



			'分块读取

			PartSize = ChunkReadSize

			if PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead

			DataPart = Request.BinaryRead(PartSize)

			BytesRead = BytesRead + PartSize



			DoteyUpload_SourceData.Write DataPart



			Progress.UploadedBytes = BytesRead

			Progress.LastActivity = Now()



			' 更新进度信息

			UpdateProgressInfo progressID



		Loop



		' 上传结束后更新进度信息

		Progress.ReadyState = "loaded" '上传结束

		UpdateProgressInfo progressID



		Dim Binary

		DoteyUpload_SourceData.Position = 0

		Binary = DoteyUpload_SourceData.Read



		Dim BoundaryStart, BoundaryEnd, PosEndOfHeader, IsBoundaryEnd

		Dim Header, bFieldContent

		Dim FieldName

		Dim File

		Dim TwoCharsAfterEndBoundary



		BoundaryStart = InStrB(Binary, Boundary)

		BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary, 0)



		Do While (BoundaryStart > 0 And BoundaryEnd > 0 And Not IsBoundaryEnd)

			' 获取表单头的结束位置

			PosEndOfHeader = InStrB(BoundaryStart + LenB(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

						

			' 分离表单头信息，类似于：

			' Content-Disposition: form-data; name="file1"; filename="G:\homepage.txt"

			' Content-Type: text/plain

			Header = BinaryToString(MidB(Binary, BoundaryStart + LenB(Boundary) + 2, PosEndOfHeader - BoundaryStart - LenB(Boundary) - 2))



			' 分离表单内容

			bFieldContent = MidB(Binary, (PosEndOfHeader + 4), BoundaryEnd - (PosEndOfHeader + 4) - 2)

			

			FieldName = GetFieldName(Header)

		' 如果是附件

			If InStr (Header,"filename=""") > 0 Then

				Set File = New FileInfo

				

				' 获取文件相关信息

				Dim clientPath

				clientPath = GetFileName(Header)

				File.FileName = GetFileNameByPath(clientPath)

				File.FileExt = GetFileExt(clientPath)

				File.FilePath = clientPath

				File.FileType = GetFileType(Header)

				File.FileStart = PosEndOfHeader + 3

				File.FileSize = BoundaryEnd - (PosEndOfHeader + 4) - 2

				File.FormName = FieldName



				' 如果该文件不为空并不存在该表单项保存之

				If Not Files.Exists(FieldName) And File.FileSize > 0 Then

					Files.Add FieldName, File

				End If

jiaxinhu517 2007-11-21

打赏
举报

我的upload.asp:
<%

Dim DoteyUpload_SourceData

Class DoteyUpload

Public Files
Public Form
Public MaxTotalBytes
Public Version
Public ProgressID
Public ErrMsg

Private BytesRead
Private ChunkReadSize
Private Info
Private Progress

Private UploadProgressInfo
Private CrLf

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
Boundary = StringToBinary(Boundary)

Progress.ReadyState = "loading" '开始上传
Progress.TotalBytes = TotalBytes
UpdateProgressInfo progressID

Dim DataPart, PartSize
BytesRead = 0

'循环分块读取
Do While BytesRead < TotalBytes

'分块读取
PartSize = ChunkReadSize
if PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead
DataPart = Request.BinaryRead(PartSize)
BytesRead = BytesRead + PartSize

DoteyUpload_SourceData.Write DataPart

Progress.UploadedBytes = BytesRead
Progress.LastActivity = Now()

' 更新进度信息
UpdateProgressInfo progressID

Loop

' 上传结束后更新进度信息
Progress.ReadyState = "loaded" '上传结束
UpdateProgressInfo progressID

Dim Binary
DoteyUpload_SourceData.Position = 0
Binary = DoteyUpload_SourceData.Read

Dim BoundaryStart, BoundaryEnd, PosEndOfHeader, IsBoundaryEnd
Dim Header, bFieldContent
Dim FieldName
Dim File
Dim TwoCharsAfterEndBoundary

BoundaryStart = InStrB(Binary, Boundary)
BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary, 0)

Do While (BoundaryStart > 0 And BoundaryEnd > 0 And Not IsBoundaryEnd)
' 获取表单头的结束位置
PosEndOfHeader = InStrB(BoundaryStart + LenB(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

' 分离表单头信息，类似于：
' Content-Disposition: form-data; name="file1"; filename="G:\homepage.txt"
' Content-Type: text/plain
Header = BinaryToString(MidB(Binary, BoundaryStart + LenB(Boundary) + 2, PosEndOfHeader - BoundaryStart - LenB(Boundary) - 2))

' 分离表单内容
bFieldContent = MidB(Binary, (PosEndOfHeader + 4), BoundaryEnd - (PosEndOfHeader + 4) - 2)

FieldName = GetFieldName(Header)
' 如果是附件
If InStr (Header,"filename=""") > 0 Then
Set File = New FileInfo

' 获取文件相关信息
Dim clientPath
clientPath = GetFileName(Header)
File.FileName = GetFileNameByPath(clientPath)
File.FileExt = GetFileExt(clientPath)
File.FilePath = clientPath
File.FileType = GetFileType(Header)
File.FileStart = PosEndOfHeader + 3
File.FileSize = BoundaryEnd - (PosEndOfHeader + 4) - 2
File.FormName = FieldName

' 如果该文件不为空并不存在该表单项保存之
If Not Files.Exists(FieldName) And File.FileSize > 0 Then
Files.Add FieldName, File
End If
'表单数据
Else
' 允许同名表单
If Form.Exists(FieldName) Then
Form(FieldName) = Form(FieldName) & "," & BinaryToString(bFieldContent)
Else
Form.Add FieldName, BinaryToString(bFieldContent)
End If
End If

' 是否结束位置
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, BoundaryEnd + LenB(Boundary), 2))
IsBoundaryEnd = TwoCharsAfterEndBoundary = "--"

If Not IsBoundaryEnd Then ' 如果不是结尾, 继续读取下一块
BoundaryStart = BoundaryEnd
BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary)
End If
Loop

' 解析文件结束后更新进度信息
Progress.UploadedBytes = TotalBytes
Progress.ReadyState = "interactive" '解析文件结束
UpdateProgressInfo progressID

End Sub

'异常信息
Private Sub Raise(Message)
ErrMsg = ErrMsg & "[" & Now & "]" & Message & "<BR>"

Progress.ErrorMessage = Message
UpdateProgressInfo ProgressID

'call Err.Raise(vbObjectError, "DoteyUpload", Message)

End Sub

' 取边界值
Private Function GetBoundary()
Dim ContentType, ctArray, bArray
ContentType = Request.ServerVariables("HTTP_CONTENT_TYPE")
ctArray = Split(ContentType, ";")
If Trim(ctArray(0)) = "multipart/form-data" Then
bArray = Split(Trim(ctArray(1)), "=")
GetBoundary = "--" & Trim(bArray(1))
Else '如果form中没有包括multipart/form-data上传是无效的
GetBoundary = null
Raise("如果form中没有包括multipart/form-data上传是无效的")
End If
End Function

jiaxinhu517 2007-11-21

打赏
举报

jiaxinhu517 2007-11-21

打赏
举报

使用上面的代码中的
userfilepath=temp2(1) '取出数组元素
userfilepath1=temp2(2)
userfilepath2=temp2(3)
会出现下面的错误:
form传递来的数据:

Microsoft VBScript 运行时错误错误 '800a0009'

下标越界: '[number: 1]'

/showup2/uptodir.asp，行 20
不用则出现存入三个的路径到数据库中的时候,最后一张的路径会覆盖前面二个的路径?????

✦双11狂欢大促✦

怎样用asp实现多张图片同时上传并读取????

相关推荐

双11狂欢大促