ixs_clsup.asp

一个较完备的交互式网络教学系统 开发语言为 asp

<%
Class iXs_ClsUp
Rem 本类修改自风声无组件上传类 2.08 Beta 1，适应爱雪儿图文管理系统使用。

	Private P_MaxSize, P_TotalSize, P_FileType, P_SavePath, P_AutoSave, P_Error
	Private ObjForm, BinForm, BinItem, LngTime
	Public	FormItem, FileItem, StrDate, UpLoaddingDate
	' ============================================
	' 返回版本信息
	' ============================================
	Public Property Get Version
		Version = "爱雪儿无组件上传类 Version 1.0.0"
	End Property
	' ============================================
	' 返回错误信息
	' ============================================
	Public Property Get Error
		Error = P_Error
	End Property
	' ============================================
	' 返回上传文件最大值 单个文件
	' ============================================
	Public Property Get MaxSize
		MaxSize = P_MaxSize
	End Property
	' ============================================
	' 设置上传文件最大值 单个文件
	' ============================================
	Public Property Let MaxSize(LngSize)
		If IsNumeric(LngSize) Then
			P_MaxSize = Clng(LngSize)
		End If
	End Property
	' ============================================
	' 返回上传文件最大值 全局
	' ============================================
	Public Property Get TotalSize
		TotalSize = P_TotalSize
	End Property
	' ============================================
	' 设置上传文件最大值 全局
	' ============================================
	Public Property Let TotalSize(LngSize)
		If IsNumeric(LngSize) Then
			P_TotalSize = Clng(LngSize)
		End If
	End Property
	' ============================================
	' 返回允许上传的文件类型 扩展名
	' ============================================
	Public Property Get FileType
		FileType = P_FileType
	End Property
	' ============================================
	' 设置允许上传的文件类型 扩展名
	' ============================================
	Public Property Let FileType(strType)
		P_FileType = strType
	End Property
	' ============================================
	' 返回文件保存路径
	' ============================================
	Public Property Get SavePath
		SavePath = P_SavePath
	End Property
	' ============================================
	' 设置文件保存路径
	' ============================================
	Public Property Let SavePath(StrPath)
		P_SavePath = Replace(StrPath, chr(0), "") & CreatePath(StrPath)
	End Property
	' ============================================
	' 返回自动保存信息
	' ============================================
	Public Property Get AutoSave
		AutoSave = P_AutoSave
	End Property
	' ============================================
	' 设置Open方法处理文件的方式，对其他方法无效
	' ============================================
	Public Property Let AutoSave(byVal Flag)
		Select Case Flag
			Case 0 ' 取无重复的服务器时间字符串为文件名自动保存文件
			Case 1 ' 取源文件名自动保存文件
			Case 2 ' 不自动保存文件，Open之后请用Save/GetData方法保存文件
			Case False Flag = 2
			Case Else Flag = 0
		End Select
		P_AutoSave = Flag
	End Property
	' ============================================
	' 类初始化
	' ============================================
	Private Sub Class_Initialize
		P_Error	    = -1
		P_MaxSize   = 1536000 ' 单位：字节
		P_FileType  = "gif/jpg/jpeg/bmp/png/rar/txt/zip/mid"
		P_SavePath  = "UploadFile/"
		P_AutoSave  = 0
		P_TotalSize = 0	
		StrDate	    = Replace(Replace(Replace(CStr(Now()), "-", ""), ":", ""), " ", "")
		Randomize Timer()
		LngTime	    = Clng(1000 + Rnd()*8999)
		UpLoaddingDate = 0
		Set BinForm = Server.CreateObject("ADODB.Stream")
		Set BinItem = Server.CreateObject("ADODB.Stream")
		Set ObjForm = Server.CreateObject("Scripting.Dictionary")
		ObjForm.CompareMode = 1
	End Sub
	' ============================================
	' 类结束
	' ============================================
	Private Sub Class_Terminate
		ObjForm.RemoveAll
		Set ObjForm = Nothing
		Set BinItem = Nothing
		If P_Error <> 4 Then BinForm.Close()
		Set BinForm = Nothing
	End Sub
	' ============================================
	' 打开对象，打开之前可以重定义对象参数属性MaxSize等
	' ============================================
	Public Sub Open()
		If P_Error = -1 Then
			P_Error = 0
		Else
			Exit Sub
		End If
		Dim LngRequestSize, LngReadSize, BinRequestData, StrFormItem, StrFileItem ,P_ChunkByte, IntTemp, StrTemp
		Const StrSplit = "'"">"
		LngRequestSize = Request.TotalBytes
		If (LngRequestSize < 1) Or ((LngRequestSize > P_TotalSize) And P_TotalSize <> 0) Then
			P_Error = 4
			Exit Sub
		End If
		BinForm.Type = 1
		BinForm.Open
		LngReadSize = 0
		P_ChunkByte = 102400
		BinItem.Type = 2
		BinItem.Charset = "gb2312"
		BinItem.Open
		Response.Flush()
		Do
			BinForm.Write Request.BinaryRead(P_ChunkByte)
			LngReadSize = LngReadSize + P_ChunkByte
			If  LngReadSize >= LngRequestSize Then Exit Do
			BinItem.WriteText "lngTotalSize=" & LngRequestSize & ";lngReadSize=" & LngReadSize & ";"
			BinItem.SaveToFile Server.MapPath("UpLoadData/" & UpLoaddingDate & ".js"),2
			Response.flush()
		Loop
		BinItem.WriteText "lngTotalSize=" & LngRequestSize & ";lngReadSize=" & LngReadSize & ";"
		BinItem.SaveToFile Server.MapPath("UpLoadData/" & UpLoaddingDate & ".js"),2
		BinItem.Close()
		Response.Flush()
		BinForm.Position = 0
		BinRequestData = BinForm.Read()

		Dim bCrLf, StrSeparator, IntSeparator
		bCrLf = ChrB(13) & ChrB(10)

		IntSeparator = InstrB(1, BinRequestData, bCrLf)-1
		StrSeparator = LeftB(BinRequestData, IntSeparator)

		Dim P_Start, P_End, StrItem, StrInam
		Dim StrFtyp, StrFnam, StrFext, LngFsiz
		P_Start = IntSeparator + 2
		Do
			P_End  = InStrB(P_Start, BinRequestData, bCrLf & bCrLf) + 3
			BinItem.Type=1
			BinItem.Open
			BinForm.Position = P_Start
			BinForm.CopyTo BinItem, P_End - P_Start
			BinItem.Position = 0
			BinItem.Type = 2
			BinItem.Charset = "gb2312"
			StrItem = BinItem.ReadText
			BinItem.Close()

			P_Start = P_End
			P_End  = InStrB(P_Start, BinRequestData, StrSeparator)-1
			BinItem.Type = 1
			BinItem.Open
			BinForm.Position = P_Start
			LngFsiz = P_End-P_Start-2
			BinForm.CopyTo BinItem, LngFsiz

			IntTemp = Instr(39, StrItem, """")
			StrInam = Mid(StrItem, 39, IntTemp-39)

			If Instr(IntTemp, StrItem, "filename=""") <> 0 Then
			If Not ObjForm.Exists(StrInam & "_From") Then
				StrFileItem = StrFileItem & StrSplit & StrInam
				If BinItem.Size <> 0 Then
					IntTemp = IntTemp + 13
					StrFtyp = Mid(StrItem, Instr(IntTemp, StrItem, "Content-Type: ") + 14)
					StrTemp = Mid(StrItem, IntTemp, Instr(IntTemp, StrItem, """") - IntTemp)
					IntTemp = InstrRev(StrTemp, "\")
					StrFnam = Mid(StrTemp, IntTemp + 1)
					ObjForm.Add StrInam & "_Type", Replace(StrFtyp, vbCrLF, "")
					ObjForm.Add StrInam & "_Name", StrFnam
					ObjForm.Add StrInam & "_Path", Left(StrTemp, IntTemp)
					ObjForm.Add StrInam & "_Size", LngFsiz
					If Instr(IntTemp, StrTemp, ".") <> 0 Then
						StrFext = Mid(StrTemp, InstrRev(StrTemp, ".") + 1)
					Else
						StrFext = ""
					End If
					If Left(StrFtyp, 6) = "image/" Then
						BinItem.Position = 0
						BinItem.Type = 1
						StrTemp = BinItem.Read(10)
						' 更改了原来的判断方法，兼容性更强
						If InStr(StrFtyp, "jpeg") > 0 Then
							If LCase(StrFext) <> "jpg" Then StrFext = "jpg"
							BinItem.Position = 3
							Do While Not BinItem.EOS
								Do
									IntTemp = AscB(BinItem.Read(1))
								Loop While IntTemp = 255 And Not BinItem.EOS
								If IntTemp < 192 Or IntTemp > 195 Then
									BinItem.Read(Bin2Val(BinItem.Read(2))-2)
								Else
									Exit Do
								End If
								Do
									IntTemp = AscB(BinItem.Read(1))
								Loop While IntTemp < 255 And Not BinItem.EOS
							Loop
							BinItem.Read(3)
							ObjForm.Add StrInam & "_Height", Bin2Val(BinItem.Read(2))
							ObjForm.Add StrInam & "_Width", Bin2Val(BinItem.Read(2))
						ElseIf InStr(StrFtyp, "/png") > 0 Then
							If LCase(StrFext) <> "png" Then StrFext = "png"
							BinItem.Position = 18
							ObjForm.Add StrInam & "_Width", Bin2Val(BinItem.Read(2))
							BinItem.Read(2)
							ObjForm.Add StrInam & "_Height", Bin2Val(BinItem.Read(2))