<%
'----------------------------------------------------------
'**************  风声 ASP 无组件上传类 V2.11  *************
'作者：风声
'网站：http://www.fonshen.com
'邮件：webmaster@fonshen.com
'版权：版权全体,源代码公开,各种用途均可免费使用
'**********************************************************
'----------------------------------------------------------
Class UpLoadClass

	Private m_TotalSize,m_MaxSize,m_FileType,m_SavePath,m_AutoSave,m_Error,m_Charset
	Private m_dicForm,m_binForm,m_binItem,m_strDate,m_lngTime
	Public	FormItem,FileItem

	Public Property Get Version
		Version="Fonshen ASP UpLoadClass Version 2.11"
	End Property

	Public Property Get Error
		Error=m_Error
	End Property

	Public Property Get Charset
		Charset=m_Charset
	End Property
	Public Property Let Charset(strCharset)
		m_Charset=strCharset
	End Property

	Public Property Get TotalSize
		TotalSize=m_TotalSize
	End Property
	Public Property Let TotalSize(lngSize)
		if isNumeric(lngSize) then m_TotalSize=Clng(lngSize)
	End Property

	Public Property Get MaxSize
		MaxSize=m_MaxSize
	End Property
	Public Property Let MaxSize(lngSize)
		if isNumeric(lngSize) then m_MaxSize=Clng(lngSize)
	End Property

	Public Property Get FileType
		FileType=m_FileType
	End Property
	Public Property Let FileType(strType)
		m_FileType=strType
	End Property

	Public Property Get SavePath
		SavePath=m_SavePath
	End Property
	Public Property Let SavePath(strPath)
		m_SavePath=Replace(strPath,chr(0),"")
	End Property

	Public Property Get AutoSave
		AutoSave=m_AutoSave
	End Property
	Public Property Let AutoSave(byVal Flag)
		select case Flag
			case 0,1,2: m_AutoSave=Flag
		end select
	End Property

	Private Sub Class_Initialize
		m_Error	   = -1
		m_Charset  = "gb2312"
		m_TotalSize= 0
		m_MaxSize  = 0
		m_FileType = ""						'可设置jpg/gif/rar等类型，空为不限制
		
		Dim month_day
		month_day=year(now)&"-"&month(now)&"/"
		m_SavePath="pic/"&month_day  '当前目录请设为空	
		CheckFolder(m_SavePath)		'检测文件夹是否存在
		m_AutoSave = 0
		Dim dtmNow : dtmNow = Date()
		m_strDate  = Year(dtmNow)&Right("0"&Month(dtmNow),2)&Right("0"&Day(dtmNow),2)
		m_lngTime  = Clng(Timer()*1000)
		Set m_binForm = Server.CreateObject("ADODB.Stream")
		Set m_binItem = Server.CreateObject("ADODB.Stream")
		Set m_dicForm = Server.CreateObject("Scripting.Dictionary")
		m_dicForm.CompareMode = 1
	End Sub

	Private Sub Class_Terminate
		m_dicForm.RemoveAll
		Set m_dicForm = nothing
		Set m_binItem = nothing
		m_binForm.Close()
		Set m_binForm = nothing
	End Sub

	Public Function Open()
		Open = 0
		if m_Error=-1 then
			m_Error=0
		else
			Exit Function
		end if
		Dim lngRequestSize : lngRequestSize=Request.TotalBytes
		if m_TotalSize>0 and lngRequestSize>m_TotalSize then
			m_Error=5
			Exit Function
		elseif lngRequestSize<1 then
			m_Error=4
			Exit Function
		end if

		Dim lngChunkByte : lngChunkByte = 102400
		Dim lngReadSize : lngReadSize = 0
		m_binForm.Type = 1
		m_binForm.Open()
		do
			m_binForm.Write Request.BinaryRead(lngChunkByte)
			lngReadSize=lngReadSize+lngChunkByte
			if  lngReadSize >= lngRequestSize then exit do
		loop		
		m_binForm.Position=0
		Dim binRequestData : binRequestData=m_binForm.Read()

		Dim bCrLf,strSeparator,intSeparator
		bCrLf=ChrB(13)&ChrB(10)
		intSeparator=InstrB(1,binRequestData,bCrLf)-1
		strSeparator=LeftB(binRequestData,intSeparator)

		Dim strItem,strInam,strFtyp,strPuri,strFnam,strFext,lngFsiz
		Const strSplit="'"">"
		Dim strFormItem,strFileItem,intTemp,strTemp
		Dim p_start : p_start=intSeparator+2
		Dim p_end
		Do
			p_end = InStrB(p_start,binRequestData,bCrLf&bCrLf)-1
			m_binItem.Type=1
			m_binItem.Open()
			m_binForm.Position=p_start
			m_binForm.CopyTo m_binItem,p_end-p_start
			m_binItem.Position=0
			m_binItem.Type=2
			m_binItem.Charset=m_Charset
			strItem = m_binItem.ReadText()
			m_binItem.Close()
			intTemp=Instr(39,strItem,"""")
			strInam=Mid(strItem,39,intTemp-39)

			p_start = p_end + 4
			p_end = InStrB(p_start,binRequestData,strSeparator)-1
			m_binItem.Type=1
			m_binItem.Open()
			m_binForm.Position=p_start
			lngFsiz=p_end-p_start-2
			m_binForm.CopyTo m_binItem,lngFsiz

			if Instr(intTemp,strItem,"filename=""")<>0 then
			if not m_dicForm.Exists(strInam&"_From") then
				strFileItem=strFileItem&strSplit&strInam
				if m_binItem.Size<>0 then
					intTemp=intTemp+13
					strFtyp=Mid(strItem,Instr(intTemp,strItem,"Content-Type: ")+14)
					strPuri=Mid(strItem,intTemp,Instr(intTemp,strItem,"""")-intTemp)
					intTemp=InstrRev(strPuri,"\")
					strFnam=Mid(strPuri,intTemp+1)
					m_dicForm.Add strInam&"_Type",strFtyp
					m_dicForm.Add strInam&"_Name",strFnam
					m_dicForm.Add strInam&"_Path",Left(strPuri,intTemp)
					m_dicForm.Add strInam&"_Size",lngFsiz
					if Instr(strFnam,".")<>0 then
						strFext=Mid(strFnam,InstrRev(strFnam,".")+1)
					else
						strFext=""
					end if

					select case strFtyp
					case "image/jpeg","image/pjpeg","image/jpg"
						if Lcase(strFext)<>"jpg" then strFext="jpg"
						m_binItem.Position=3
						do while not m_binItem.EOS
							do
								intTemp = Ascb(m_binItem.Read(1))
							loop while intTemp = 255 and not m_binItem.EOS
							if intTemp < 192 or intTemp > 195 then
								m_binItem.read(Bin2Val(m_binItem.Read(2))-2)
							else
								Exit do
							end if
							do
								intTemp = Ascb(m_binItem.Read(1))
							loop while intTemp < 255 and not m_binItem.EOS
						loop
						m_binItem.Read(3)
						m_dicForm.Add strInam&"_Height",Bin2Val(m_binItem.Read(2))
						m_dicForm.Add strInam&"_Width",Bin2Val(m_binItem.Read(2))
					case "image/gif"
						if Lcase(strFext)<>"gif" then strFext="gif"
						m_binItem.Position=6
						m_dicForm.Add strInam&"_Width",BinVal2(m_binItem.Read(2))
						m_dicForm.Add strInam&"_Height",BinVal2(m_binItem.Read(2))
					case "image/png"
						if Lcase(strFext)<>"png" then strFext="png"
						m_binItem.Position=18
						m_dicForm.Add strInam&"_Width",Bin2Val(m_binItem.Read(2))
						m_binItem.Read(2)
						m_dicForm.Add strInam&"_Height",Bin2Val(m_binItem.Read(2))
					case "image/bmp"
						if Lcase(strFext)<>"bmp" then strFext="bmp"
						m_binItem.Position=18
						m_dicForm.Add strInam&"_Width",BinVal2(m_binItem.Read(4))
						m_dicForm.Add strInam&"_Height",BinVal2(m_binItem.Read(4))
					case "application/x-shockwave-flash"
						if Lcase(strFext)<>"swf" then strFext="swf"
						m_binItem.Position=0
						if Ascb(m_binItem.Read(1))=70 then
							m_binItem.Position=8
							strTemp = Num2Str(Ascb(m_binItem.Read(1)), 2 ,8)
							intTemp = Str2Num(Left(strTemp, 5), 2)
							strTemp = Mid(strTemp, 6)
							while (Len(strTemp) < intTemp * 4)
								strTemp = strTemp & Num2Str(Ascb(m_binItem.Read(1)), 2 ,8)
							wend
							m_dicForm.Add strInam&"_Width", Int(Abs(Str2Num(Mid(strTemp, intTemp + 1, intTemp), 2) - Str2Num(Mid(strTemp, 1, intTemp), 2)) / 20)
							m_dicForm.Add strInam&"_Height",Int(Abs(Str2Num(Mid(strTemp, 3 * intTemp + 1, intTemp), 2) - Str2Num(Mid(strTemp, 2 * intTemp + 1, intTemp), 2)) / 20)
						end if
					end select

					m_dicForm.Add strInam&"_Ext",strFext
					m_dicForm.Add strInam&"_From",p_start
					if m_AutoSave<>2 then
						intTemp=GetFerr(lngFsiz,strFext)
						m_dicForm.Add strInam&"_Err",intTemp
						if intTemp=0 then
							if m_AutoSave=0 then
								strFnam=GetTimeStr()
								if strFext<>"" then strFnam=strFnam&"."&strFext
							end if
							m_binItem.SaveToFile Server.MapPath(m_SavePath&strFnam),2
							m_dicForm.Add strInam,strFnam
						end if
					end if
				else
					m_dicForm.Add strInam&"_Err",-1
				end if
			end if
			else
				m_binItem.Position=0
				m_binItem.Type=2
				m_binItem.Charset=m_Charset
				strTemp=m_binItem.ReadText
				if m_dicForm.Exists(strInam) then
					m_dicForm(strInam) = m_dicForm(strInam)&","&strTemp
				else
					strFormItem=strFormItem&strSplit&strInam
					m_dicForm.Add strInam,strTemp
				end if
			end if

			m_binItem.Close()
			p_start = p_end+intSeparator+2
		loop Until p_start+3>lngRequestSize
		FormItem=Split(strFormItem,strSplit)
		FileItem=Split(strFileItem,strSplit)
		
		Open = lngRequestSize
	End Function

	Private Function GetTimeStr()
		m_lngTime=m_lngTime+1
		GetTimeStr=m_strDate&Right("00000000"&m_lngTime,8)
	End Function

	Private Function GetFerr(lngFsiz,strFext)
		dim intFerr
		intFerr=0
		if lngFsiz>m_MaxSize and m_MaxSize>0 then
			if m_Error=0 or m_Error=2 then m_Error=m_Error+1
			intFerr=intFerr+1
		end if
		if Instr(1,LCase("/"&m_FileType&"/"),LCase("/"&strFext&"/"))=0 and m_FileType<>"" then
			if m_Error<2 then m_Error=m_Error+2
			intFerr=intFerr+2
		end if
		GetFerr=intFerr
	End Function

	Public Function Save(Item,strFnam)
		Save=false
		if m_dicForm.Exists(Item&"_From") then
			dim intFerr,strFext
			strFext=m_dicForm(Item&"_Ext")
			intFerr=GetFerr(m_dicForm(Item&"_Size"),strFext)
			if m_dicForm.Exists(Item&"_Err") then
				if intFerr=0 then
					m_dicForm(Item&"_Err")=0
				end if
			else
				m_dicForm.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=m_dicForm(Item&"_Name")
				end select
			end if
			m_binItem.Type = 1
			m_binItem.Open
			m_binForm.Position = m_dicForm(Item&"_From")
			m_binForm.CopyTo m_binItem,m_dicForm(Item&"_Size")
			m_binItem.SaveToFile Server.MapPath(m_SavePath&strFnam),2
			m_binItem.Close()
			if m_dicForm.Exists(Item) then
				m_dicForm(Item)=strFnam
			else
				m_dicForm.Add Item,strFnam
			end if
			Save=true
		end if
	End Function

	Public Function GetData(Item)
		GetData=""
		if m_dicForm.Exists(Item&"_From") then
			if GetFerr(m_dicForm(Item&"_Size"),m_dicForm(Item&"_Ext"))<>0 then Exit Function
			m_binForm.Position = m_dicForm(Item&"_From")
			GetData = m_binForm.Read(m_dicForm(Item&"_Size"))
		end if
	End Function

	Public Function Form(Item)
		if m_dicForm.Exists(Item) then
			Form=m_dicForm(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,i
		ret = ""
		while(num >= base)
			i   = num Mod base
			ret = i & ret
			num = (num - i) / 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
	
	
	
	'检测文件夹是否存在，不存在则创建
	Function CheckFolder(CFolder)
		Dim MyFileObject,MyPath
		Set MyFileObject=Server.CreateObject("Scripting.FileSystemObject")
		MyPath=server.mappath(CFolder)
		IF MyFileObject.FolderExists(MyPath)=False Then 
			MyFileObject.Createfolder(MyPath) 
		End IF
		Set MyFileObject = Nothing
	End Function

End Class
%>