clsfileup.asp

1

				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

	' 总大小
	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

	function CheckFileType(filename)
		const adTypeBinary=1
		dim jpg(1):jpg(0)=CByte(&HFF):jpg(1)=CByte(&HD8)
		dim bmp(1):bmp(0)=CByte(&H42):bmp(1)=CByte(&H4D)
		dim png(3):png(0)=CByte(&H89):png(1)=CByte(&H50):png(2)=CByte(&H4E):png(3)=CByte(&H47)
		dim gif(5):gif(0)=CByte(&H47):gif(1)=CByte(&H49):gif(2)=CByte(&H46):gif(3)=CByte(&H39):gif(4)=CByte(&H38):gif(5)=CByte(&H61)
		CheckFileType=false
		dim fstream,fileExt,stamp,i
		fileExt=mid(filename,InStrRev(filename,".")+1)
		set fstream=Server.createobject("ADODB.Stream")
		fstream.Open
		fstream.Type=adTypeBinary
		fstream.LoadFromFile filename
		fstream.position=0
		select case fileExt
		case "jpg","jpeg"
		stamp=fstream.read(2)
		for i=0 to 1
		if ascB(MidB(stamp,i+1,1))=jpg(i) then CheckFileType=true else CheckFileType=false
		next
		case "gif"
		stamp=fstream.read(6)
		for i=0 to 5
		if ascB(MidB(stamp,i+1,1))=gif(i) then CheckFileType=true else CheckFileType=false
		next
		case "png"
		stamp=fstream.read(4)
		for i=0 to 3
		if ascB(MidB(stamp,i+1,1))=png(i) then CheckFileType=true else CheckFileType=false
		next
		case "bmp"
		stamp=fstream.read(2)
		for i=0 to 1
		if ascB(MidB(stamp,i+1,1))=bmp(i) then CheckFileType=true else CheckFileType=false
		next
		end select
		fstream.Close
		set fseteam=nothing
		if err.number<>0 then CheckFileType=false
	end function

	function ctime 
		ctime = now()
		ctime = replace(ctime,"-","")
		ctime = replace(ctime," ","") 
		ctime = replace(ctime,":","")
		ctime = replace(ctime,"/","")
		ctime = replace(ctime,"\","")
		ctime = replace(ctime,"PM","")
		ctime = replace(ctime,"AM","")
		ctime = replace(ctime,"上午","")
		ctime = replace(ctime,"下午","")
	end function

	Function RndNumber
		MaxNum=30000
		MinNum=10000
		Randomize 
		RndNumber=int((MaxNum-MinNum+1)*rnd+MinNum)
		RndNumber=RndNumber
	End Function
%>