<%
'==================================
'=文 件 名：admin_upfile_class.asp
'=適用版本：游戲天府WAP網(wǎng)站管理系統(tǒng)(CMS)V1.1
'=官方版權(quán)：http://www.gotf.cn
'=文件功能：上傳文件處理
'=文件作者：游戲天府
'=發(fā)行時(shí)間：2007-02-01
'==================================
'文件上傳類(lèi)
Class UpFile_Class

Dim Form,File
Dim AllowExt_	'允許上傳類(lèi)型(白名單)
Dim NoAllowExt_	'不允許上傳類(lèi)型(黑名單)
Private	oUpFileStream	'上傳的數(shù)據(jù)流
Private isErr_		'錯(cuò)誤的代碼,0或true表示無(wú)錯(cuò)
Private ErrMessage_	'錯(cuò)誤的字符串信息
Private isGetData_	'指示是否已執(zhí)行過(guò)GETDATA過(guò)程

	'添加的代碼，刪除包含非法代碼的文件
Public Function alertAndRemoveFile(Byval PathAndFileName)
		on error resume next
		dim MyFileObject,MyTextFile,NeedDel,StrCheckFile
		alertAndRemoveFile=false
		Set MyFileObject=Server.CreateObject("Scripting.FileSystemObject")
		Set MyTextFile=MyFileObject.OpenTextFile(PathAndFileName)
		DO
			If MytextFile.AtEndOfStream Then Exit Do
			StrCheckFile=MytextFile.ReadLine
			if includeBadWord(StrCheckFile) Then'調(diào)用判斷函數(shù)
				alertAndRemoveFile=true
				NeedDel=true
				Exit Do
			End If
		Loop
		MYTextFile.Close
		If NeedDel Then MyFileObject.DeleteFile PathAndFileName
		set MYTextFile=nothing
		set MyFileObject=nothing
	End Function
		'檢查文本是否有有害代碼
	Private Function includeBadWord(Byval FileStr)
		includeBadWord=false
		dim StrBadWord,ArrStrBadWord,i
		StrBadWord="server.|.createobject|execute|.encode|eval|request"'定義惡意代碼
		ArrStrBadWord=split(StrBadWord,"|")
		For i=0 to ubound(ArrStrBadWord)
			if Instr(LCase(FileStr),ArrStrBadWord(i))>0 Then
				'response.write(ArrStrBadWord(i))
				includeBadWord=true
				Exit For
			End If
		Next
	End Function

'------------------------------------------------------------------
'類(lèi)的屬性
Public Property Get Version
	Version="無(wú)懼上傳類(lèi) Version V2.0"
End Property

Public Property Get isErr		'錯(cuò)誤的代碼,0或true表示無(wú)錯(cuò)
	isErr=isErr_
End Property

Public Property Get ErrMessage		'錯(cuò)誤的字符串信息
	ErrMessage=ErrMessage_
End Property

Public Property Get AllowExt		'允許上傳類(lèi)型(白名單)
	AllowExt=AllowExt_
End Property

Public Property Let AllowExt(Value)	'允許上傳類(lèi)型(白名單)
	AllowExt_=LCase(Value)
End Property

Public Property Get NoAllowExt		'不允許上傳類(lèi)型(黑名單)
	NoAllowExt=NoAllowExt_
End Property

Public Property Let NoAllowExt(Value)	'不允許上傳類(lèi)型(黑名單)
	NoAllowExt_=LCase(Value)
End Property

'----------------------------------------------------------------
'類(lèi)實(shí)現(xiàn)代碼

'初始化類(lèi)
Private Sub Class_Initialize
	isErr_ = 0
	NoAllowExt=""	
	NoAllowExt=LCase(NoAllowExt)
	AllowExt=allowupfile	'可以上傳的文件V1.1后續(xù)版本改為在基本設(shè)置中控制
	AllowExt=LCase(AllowExt)
	isGetData_=false
End Sub

'類(lèi)結(jié)束
Private Sub Class_Terminate	
	on error Resume Next
	'清除變量及對(duì)像
	Form.RemoveAll
	Set Form = Nothing
	File.RemoveAll
	Set File = Nothing
	oUpFileStream.Close
	Set oUpFileStream = Nothing
End Sub
'分析上傳的數(shù)據(jù)
Public Sub GetData (MaxSize)
	 '定義變量
	on error Resume Next
	if isGetData_=false then 
		Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
		Dim sFormValue,sFileName
		Dim iFindStart,iFindEnd
		Dim iFormStart,iFormEnd,sFormName
		'代碼開(kāi)始
		If Request.TotalBytes < 1 Then	'如果沒(méi)有數(shù)據(jù)上傳
			isErr_ = 1
			ErrMessage_="沒(méi)有數(shù)據(jù)上傳"
			Exit Sub
		End If
		If MaxSize > 0 Then '如果限制大小
			If Request.TotalBytes > MaxSize Then
			isErr_ = 2	'如果上傳的數(shù)據(jù)超出限制大小
			ErrMessage_="上傳的數(shù)據(jù)超出限制大小"
			Exit Sub
			End If
		End If
		Set Form = Server.CreateObject ("Scripting.Dictionary")
		Form.CompareMode = 1
		Set File = Server.CreateObject ("Scripting.Dictionary")
		File.CompareMode = 1
		Set tStream = Server.CreateObject ("ADODB.Stream")
		Set oUpFileStream = Server.CreateObject ("ADODB.Stream")
		oUpFileStream.Type = 1
		oUpFileStream.Mode = 3
		oUpFileStream.Open 
		oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
		oUpFileStream.Position = 0
		RequestBinDate = oUpFileStream.Read 
		iFormEnd = oUpFileStream.Size
		bCrLf = ChrB (13) & ChrB (10)
		'取得每個(gè)項(xiàng)目之間的分隔符
		sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
		iStart = LenB(sSpace)
		iFormStart = iStart+2
		'分解項(xiàng)目
		Do
			iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3
			tStream.Type = 1
			tStream.Mode = 3
			tStream.Open
			oUpFileStream.Position = iFormStart
			oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
			tStream.Position = 0
			tStream.Type = 2
			tStream.CharSet = "gb2312"
			sInfo = tStream.ReadText			
			'取得表單項(xiàng)目名稱(chēng)
			iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
			iFindStart = InStr (22,sInfo,"name=""",1)+6
			iFindEnd = InStr (iFindStart,sInfo,"""",1)
			sFormName = Mid	(sinfo,iFindStart,iFindEnd-iFindStart)
			'如果是文件
			If InStr (45,sInfo,"filename=""",1) > 0 Then
				Set oFileInfo = new FileInfo_Class
				'取得文件屬性
				iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
				iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,1)
				sFileName = Mid	(sinfo,iFindStart,iFindEnd-iFindStart)
				oFileInfo.FileName = GetFileName(sFileName)
				oFileInfo.FilePath = GetFilePath(sFileName)
				oFileInfo.FileExt = GetFileExt(sFileName)
				iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
				iFindEnd = InStr (iFindStart,sInfo,vbCr)
				oFileInfo.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
				oFileInfo.FileStart = iInfoEnd
				oFileInfo.FileSize = iFormStart -iInfoEnd -2
				oFileInfo.FormName = sFormName
				file.add sFormName,oFileInfo
			else
			'如果是表單項(xiàng)目
				tStream.Close
				tStream.Type = 1
				tStream.Mode = 3
				tStream.Open
				oUpFileStream.Position = iInfoEnd 
				oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
				tStream.Position = 0
				tStream.Type = 2
				tStream.CharSet = "gb2312"
				sFormValue = tStream.ReadText
				If Form.Exists (sFormName) Then
					Form (sFormName) = Form (sFormName) & ", " & sFormValue
					else
					Form.Add sFormName,sFormValue
				End If
			End If
			tStream.Close
			iFormStart = iFormStart+iStart+2
			'如果到文件尾了就退出
		Loop Until (iFormStart+2) >= iFormEnd 
		RequestBinDate = ""
		Set tStream = Nothing
		isGetData_=true
	end if
sql="select * from wapls_up"
	set rs=server.createobject("adodb.recordset")
	rs.open sql,conn,1,3
if oFileInfo.FileSize>0 then
	rs.addnew
	rs("up_size")=oFileInfo.FileSize/1024
	rs("up_format")="上傳出錯(cuò),無(wú)效文件,此次上傳存儲(chǔ)失敗!"
	rs("up_url")="上傳內(nèi)容有非法內(nèi)容!"
	rs.update
end if
rs.close
set rs=nothing
End Sub


'保存到文件,自動(dòng)覆蓋已存在的同名文件
Public Function SaveToFile(Item,Path)
	SaveToFile=SaveToFileEx(Item,Path,True)
End Function

'保存到文件,自動(dòng)設(shè)置文件名
Public Function AutoSave(Item,Path)
	AutoSave=SaveToFileEx(Item,Path,false)
End Function



'保存到文件,OVER為真時(shí),自動(dòng)覆蓋已存在的同名文件,否則自動(dòng)把文件改名保存
Private Function SaveToFileEx(Item,Path,Over)
	On Error Resume Next
	Dim oFileStream
	Dim tmpPath
	isErr=0
	Set oFileStream = CreateObject ("ADODB.Stream")
	oFileStream.Type = 1
	oFileStream.Mode = 3
	oFileStream.Open
	oUpFileStream.Position = File(Item).FileStart
	oUpFileStream.CopyTo oFileStream,File(Item).FileSize
	tmpPath=Path
	if Over then
		if isAllowExt(GetFileExt(tmpPath)) then
			oFileStream.SaveToFile tmpPath,2
			Else
			isErr_=3
			ErrMessage_="該后綴名的文件不允許上傳!"
		End if
	Else
		Path=GetFilePath(Path)
		if isAllowExt(File(Item).FileExt) then
			do
				Err.Clear()
				tmpPath=Path&GetNewFileName()&"."&File(Item).FileExt
				oFileStream.SaveToFile tmpPath
			loop Until Err.number<1
			oFileStream.SaveToFile Path
			Else
			isErr_=3
			ErrMessage_="該后綴名的文件不允許上傳!"
		End if
	End if
	oFileStream.Close
	Set oFileStream = Nothing
	if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)
End Function

'取得文件數(shù)據(jù)
Public Function FileData(Item)
	isErr_=0
	if isAllowExt(File(Item).FileExt) then
		oUpFileStream.Position = File(Item).FileStart
		FileData = oUpFileStream.Read (File(Item).FileSize)
		Else
		isErr_=3
		ErrMessage_="該后綴名的文件不允許上傳!"
		FileData=""
	End if
End Function


'取得文件路徑
Public function GetFilePath(FullPath)
  If FullPath <> "" Then
    GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))
    Else
    GetFilePath = ""
  End If
End function

'取得文件名
Public Function GetFileName(FullPath)
  If FullPath <> "" Then
    GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
    Else
    GetFileName = ""
  End If
End function

'取得文件的后綴名
Public Function GetFileExt(FullPath)
  If FullPath <> "" Then
    GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))
    Else
    GetFileExt = ""
  End If
End function

'取得一個(gè)不重復(fù)的序號(hào)
Public Function GetNewFileName()
	dim ranNum
	dim dtNow
	dtNow=Now()
	ranNum=int(90000*rnd)+10000
	'以下這段由webboy提供
	GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
End Function

Public Function isAllowExt(Ext)
	if NoAllowExt="" then
		isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))
		else
		isAllowExt=not CBool(InStr(1,";"&NoAllowExt&";",LCase(";"&Ext&";")))
	end if
End Function
End Class
'----------------------------------------------------------------------------------------------------
'文件屬性類(lèi)
Class FileInfo_Class
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class
%>