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

jiaxinhu517 2007-11-21 04:08:28
我的上传界面是:

<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

<!-- #include file="Upload.asp" -->
<!-- #include file="conn.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>
为什么我存入三个的路径到数据库中的时候,最后一张的路径会覆盖前面二个的路径?????
...全文
484 6 打赏 收藏 转发到动态 举报
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
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
  • 打赏
  • 举报
 回复
我的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
  • 打赏
  • 举报
 回复
使用上面的代码中的
userfilepath=temp2(1) '取出数组元素
userfilepath1=temp2(2)
userfilepath2=temp2(3)
会出现下面的错误:
form传递来的数据:

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

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

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

通过c#实现图片的数据库上传和读取显示，
在asp.net编程中，经常遇到客户端将图片上传给数据库，同时也需要从数据库读取图片信息予以显示的需求，本文就相关问题做了一个个人总结
asp 上传图片并打开
针对asp上传多张图片至服务器，利用二进制模式，真正实现文件上传。同时能够从数据库中读取图片，并利用js和鼠标滚轮达到缩放图片。
毕业设计精品课之ASP.NET零食商城系统的设计与实现
本套课程主要对基于ASP.NET零时上传系统进行设计和实现，该套系统界面美观，功能完善，业务逻辑紧凑，同时，以课时为单位对所有界面代码进行注释和说明。通过本套课程能够帮你解决毕业设计选题、开发、论文撰写和毕设答辩的一系列问题本套课程售价为154元  不需要源码的同学可享受活动价格优惠学习视频教程, 如需获取源码，当所有活动折扣/会员满减等最终售价低于课程价格时，请额外补足差价说明：如果需要答疑、咨询、答辩辅导、论文辅导降重、功能修改等服务请与导师协商，学员较多，无法提供免费服务。
ASP.NET实现图片无刷新异步上传预览
1.异步读取图片存入数据流并转换为二进制保存到创建好的类 2.把此类存储到SESSION里 3.把图片数据流地址传回到前台实现图片预览 4.点击上传，从session总去出二进制数据存储到相应的位置
ASP.NET中上传并读取Excel文件数据示例
如何打开Excel数据库文件，想必有很多朋友都不清楚吧，下面通过一个简单的例子，实现读取Excel数据文件
ASP

28,390

社区成员

357,060

社区内容

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

加载中

查看更多榜单
社区公告
暂无公告

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

+ 用AI写文章