<%
'=========================================================
' 文件：iXs_clsUp.asp
' 版本：爱雪儿图文管理系统 PAMS Ver 1.0.0
' 全称：iXuEr Photo & Article Management System Version 1.0.0
' 时间：2005-06-20
' 作者：Guidy
' 版权：iXuEr Studio
'=========================================================
' CopyRight (C) 2005-2008 114XP.CN All Rights Reserved.
' 官方网站：http://www.114xp.cn/
' 技术论坛：http://bbs.114xp.cn/
' 电子信箱：guidy@qq.com
'=========================================================
' 爱雪儿图文管理系统 无组件上传类
'=========================================================
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 = "无组件上传"
	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  = "Upload/"
		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))
						ElseIf InStr(StrFtyp, "/gif") > 0 Then
							If LCase(StrFext) <> "gif" Then StrFext="gif"
							BinItem.Position = 6
							ObjForm.Add StrInam & "_Width", BinVal2(BinItem.Read(2))
							ObjForm.Add StrInam & "_Height", BinVal2(BinItem.Read(2))
						ElseIf InStr(StrFtyp, "/bmp") > 0 Then
							If LCase(StrFext) <> "bmp" Then StrFext="bmp"
							BinItem.Position = 18
							ObjForm.Add StrInam & "_Width", BinVal2(BinItem.Read(4))
							ObjForm.Add StrInam & "_Height", BinVal2(BinItem.Read(4))
						Else
							' **************************************
							' 其他图片，强制返回 4 : 3 
							' **************************************
								ObjForm.Add StrInam & "_Width", 200
								ObjForm.Add StrInam & "_Height", 150
							' **************************************
						End If
					ElseIf InStr(StrFtyp, "shockwave-flash") > 0 Then
						' **************************************
						' 增加检测FLASH文件宽度和高度的方法
						' MIME:application/x-shockwave-flash
						' **************************************
						If LCase(StrFext) <> "swf" Then StrFext="swf"
						Dim BinData, sConv, nBits
						BinItem.Position = 0
						BinItem.Type = 1
						BinItem.Read(8)
						BinData = BinItem.Read(1)
						sConv = Num2Str(AscB(BinData), 2 ,8)
						nBits = Str2Num(Left(sConv, 5), 2)
						sConv = Mid(sConv, 6)
						While (Len(sConv) < nBits * 4)
							BinData = BinItem.Read(1)
							sConv = sConv & Num2Str(AscB(BinData), 2 ,8)
						Wend
						ObjForm.Add StrInam & "_Width", Int(Abs(Str2Num(Mid(sConv, 1 * nBits + 1, nBits), 2) - Str2Num(Mid(sConv, 0 * nBits + 1, nBits), 2)) / 20)
						ObjForm.Add StrInam & "_Height", Int(Abs(Str2Num(Mid(sConv, 3 * nBits + 1, nBits), 2) - Str2Num(Mid(sConv, 2 * nBits + 1, nBits), 2)) / 20)
					Else
						' **************************************
						' 当获取的对象不是图片和FLASH的时候，强制返回 0
						' **************************************
							ObjForm.Add StrInam & "_Width", 0
							ObjForm.Add StrInam & "_Height", 0
						' **************************************
					End If
					ObjForm.Add StrInam & "_Ext", StrFext
					ObjForm.Add StrInam & "_From", P_Start
					IntTemp = GetFerr(LngFsiz, StrFext)
					If P_AutoSave <> 2 Then
						ObjForm.Add StrInam & "_Err", IntTemp
						If IntTemp = 0 Then
							If P_AutoSave = 0 Then
								StrFnam = GetTimeStr()
								If StrFext <> "" Then StrFnam = StrFnam & "." & StrFext
							End If
							BinItem.SaveToFile Server.MapPath(P_SavePath & StrFnam), 2
							ObjForm.Add StrInam, StrFnam
						End If
					End If
				Else
					ObjForm.Add StrInam & "_Err", -1
				End If
			End If
			Else
				BinItem.Position = 0
				BinItem.Type = 2
				BinItem.Charset = "gb2312"
				StrTemp = BinItem.ReadText
				If ObjForm.Exists(StrInam) Then
					ObjForm(StrInam) = ObjForm(StrInam) & "," & StrTemp
				Else
					StrFormItem = StrFormItem & StrSplit & StrInam
					ObjForm.Add StrInam, StrTemp
				End If
			End If

			BinItem.Close()
			P_Start = P_End + IntSeparator + 2
		Loop Until P_Start + 3 > LngRequestSize
		FormItem = split(StrFormItem, StrSplit)
		FileItem = split(StrFileItem, StrSplit)
	End Sub
	' ============================================
	' 获取时间整数串 作为文件名称
	' ============================================
	Private Function GetTimeStr()
		LngTime = LngTime + 1
		GetTimeStr = StrDate & LngTime
	End Function

	Private Function GetFerr(LngFsiz, StrFext)
		Dim IntFerr
		IntFerr = 0
		If LngFsiz > P_MaxSize And P_MaxSize > 0 Then
			If P_Error = 0 Or P_Error = 2 Then P_Error = P_Error + 1
			IntFerr = IntFerr + 1
		End If
		If InStr(1, LCase("/" & P_FileType & "/"), LCase("/" & StrFext & "/")) = 0 And P_FileType <> "" Then
			If P_Error < 2 Then P_Error = P_Error + 2
			IntFerr = IntFerr + 2
		End If
		GetFerr = IntFerr
	End Function
	' ============================================
	' 保存文件，成功保存返回Ture，否则返回False
	' ============================================
	Public Function Save(Item, StrFnam)
		Rem ******************************************
		Rem Item是表单中file元素
		Rem Name是保存的文件名，可选值：
		Rem 　　０：自动取无重复的服务器时间字符串为文件名
		Rem 　　１：自动取源文件名
		Rem ******************************************
		Save = False
		If ObjForm.Exists(Item & "_From") Then
			Dim IntFerr, StrFext
			StrFext = ObjForm(Item & "_Ext")
			IntFerr = GetFerr(ObjForm(Item & "_Size"), StrFext)
			If ObjForm.Exists(Item & "_Err") Then
				If IntFerr = 0 Then
					ObjForm(Item & "_Err") = 0
				End If
			Else
				ObjForm.Add Item & "_Err", IntFerr
			End If
			If IntFerr <> 0 Then Exit Function
			If VarType(StrFnam) = 2 Then
				Select Case StrFnam
					Case 0
						StrFnam = GetTimeStr()
						If StrFext <> "" Then StrFnam = StrFnam & "." & StrFext
					Case 1
						StrFnam = ObjForm(Item & "_Name")
				End Select
			End If
			BinItem.Type = 1
			BinItem.Open
			BinForm.Position = ObjForm(Item & "_From")
			BinForm.CopyTo BinItem,ObjForm(Item & "_Size")
			BinItem.SaveToFile Server.MapPath(P_SavePath & StrFnam), 2
			BinItem.Close()
			If ObjForm.Exists(Item) Then
				ObjForm(Item) = StrFnam
			Else
				ObjForm.Add Item, StrFnam
			End If
			Save = True
		End If
	End Function
	' ============================================
	' 获取数据流，可用来保存文件到数据库，试图获取非文件数据时返回空值
	' ============================================
	Public Function GetData(Item)
		GetData = ""
		If ObjForm.Exists(Item & "_From") Then
			If GetFerr(ObjForm(Item & "_Size"), ObjForm(Item & "_Ext")) <> 0 Then Exit Function
			BinForm.Position = ObjForm(Item & "_From")
			GetData = BinFormStream.Read(ObjForm(Item & "_Size"))
		End If
	End Function
	' ============================================
	' 返回文件信息
	' ============================================
	Public Function Form(Item)
		If ObjForm.Exists(Item) Then
			Form = ObjForm(Item)
		Else
			Form = ""
		End If
	End Function
	' ============================================
	' 转换到二进制
	' ============================================
	Private Function BinVal2(Bin)
		Dim LngValue,i
		LngValue = 0
		For i = LenB(Bin) to 1 Step -1
			LngValue = LngValue * 256 + AscB(MidB(Bin, i, 1))
		Next
		BinVal2 = LngValue
	End Function
	' ============================================
	' 二进制转换
	' ============================================
	Private Function Bin2Val(Bin)
		Dim LngValue, i
		LngValue = 0
		For i = 1 To LenB(Bin)
			LngValue = LngValue * 256 + AscB(MidB(Bin, i, 1))
		Next
		Bin2Val = LngValue
	End Function

    Private Function Num2Str(Num, Base, Lens)
        Dim Ret
        Ret = ""
        While(Num >= Base)
            Ret = (Num Mod Base) & Ret
            Num = (Num - Num Mod Base) / Base
        Wend
        Num2Str = Right(String(Lens, "0") & Num & Ret, Lens)
    End Function
	
    Private Function Str2Num(Str, Base)
        Dim Ret, I
        Ret = 0 
        For I = 1 To Len(Str)
            Ret = Ret * base + Cint(Mid(Str, I, 1))
        Next
        Str2Num = Ret
    End Function
End Class

' ============================================
' 检测文件夹是否存在 如果不存在就自动创建
' ============================================
Private Function CreatePath(StrPath)
	Dim ObjFSO, Fsofolder, UpLoadPath
	Dim m
	m = Month(Now)
	If Len(m) = 1 Then m = "0" & m
	UpLoadPath = Year(now) & "-" & m	'以年月创建上传文件夹，格式：2005-04
	On Error Resume Next
	Set ObjFSO = Server.CreateObject("Scripting.FileSystemObject")
		If ObjFSO.FolderExists(Server.MapPath(StrPath & UpLoadPath)) = False Then
			ObjFSO.CreateFolder Server.MapPath(StrPath & UpLoadPath)
		End If
		If Err.Number = 0 Then
			Err.Clear
			CreatePath = UpLoadPath & "\"
		Else
			CreatePath = ""
		End If
	Set ObjFSO = Nothing
End Function
%>