<%
'商易仿淘宝4.0(多用户)
'ACCESS版演示网站：http://www.ftaobao.com(商易仿淘宝商城)
'SQL版演示网站：http://sql.ftaobao.com
'电话：0571-56907100
'QQ：1147100
%>
<!--此文件支持上传到文件夹名中有“.”文件中-->



<%
'--------------------------------------------------------------------------------------------
'转发时请保留此声明信息,这段声明不并会影响您的速度!
'*******************   商易修改先锋无组件上传类(杜绝上传漏洞版) Ver2004  ********************
'作者:梁无惧、孙立宇、apollosun、ezhonghua
'官方网站:http://www.cn13.net 
'电子邮件:e-mai1@163.com      在线QQ:8439766
'版权声明:此无上传组件是为破解商易信息港特结合网上一些程序而写成，增加了返回图片大小等功能。
'网上流行的所有的无组件上传类都有该类漏洞——黑客利用抓包嗅探、ULTRAEDIT和“网络军刀”
'等黑客工具伪造IP包,可以突破服务器端对上传文件名、路径的判断,从而巧妙上传ASP、ASA、CGI、CDX、
'CER、ASPX类型的网页木马。本人仔细分析了各种黑客手段，针对网上最流行的无惧上传类进行修改，
'在写入服务端的最后关键使黑客的如意算盘付之东流.目前提供的这个类完全堵上了上传漏洞，请放心使用！
'详细使用说明或范例请见下载附件或到本人官方站点下载！
'---------------------------------------------------------------------------------------------
class clsUp  '文件上传类
'------------------------
Dim Form,File
Dim AllowExt_	'允许上传类型(白名单)
Dim NoAllowExt_	'不允许上传类型(黑名单)
Private	oUpFileStream	'上传的数据流
Private isErr_		'错误的代码,0或true表示无错
Private ErrMessage_	'错误的字符串信息
Private isGetData_	'指示是否已执行过GETDATA过程
Private FileSize_       '文件大小
Private  imgHeight_   '图片高度
Private  imgWidth_    '图片宽度
'------------------------------------------------------------------
'类的属性
Public Property Get Version
	Version="先锋上传类（无惧类改进安全版） Version 2004"
End Property

Public Property Get isErr		'错误的代码,0或true表示无错
	isErr=isErr_
End Property

Public Property Get ErrMessage		'错误的字符串信息
	ErrMessage=ErrMessage_
End Property

Public Property Get FileSize		'文件大小
	FileSize=FileSize_
End Property

Public Property Get imgHeight		'图片高度
	imgHeight=imgHeight_
End Property

Public Property Get imgWidth		'图片宽度
	imgWidth=imgWidth_ 
End Property



Public Property Get AllowExt		'允许上传类型(白名单)
	AllowExt=AllowExt_
End Property

Public Property Let AllowExt(Value)	'允许上传类型(白名单)
	AllowExt_=LCase(Value)
End Property

Public Property Get NoAllowExt		'不允许上传类型(黑名单)
	NoAllowExt=NoAllowExt_
End Property

Public Property Let NoAllowExt(Value)	'不允许上传类型(黑名单)
	NoAllowExt_=LCase(Value)
End Property

'----------------------------------------------------------------
'类实现代码

'初始化类
Private Sub Class_Initialize
	isErr_ = 0
	NoAllowExt=""		'黑名单,可以在这里预设不可上传的文件类型,以文件的后缀名来判断,不分大小写,每个每缀名用;号分开,如果黑名单为空,则判断白名单
	NoAllowExt=LCase(NoAllowExt)
	AllowExt=""		'白名单,可以在这里预设可上传的文件类型,以文件的后缀名来判断,不分大小写,每个后缀名用;号分开
	AllowExt=LCase(AllowExt)
	isGetData_=false
End Sub

'类结束
Private Sub Class_Terminate	
	on error Resume Next
	'清除变量及对像
	Form.RemoveAll
	Set Form = Nothing
	File.RemoveAll
	Set File = Nothing
	oUpFileStream.Close
	Set oUpFileStream = Nothing
End Sub

'分析上传的数据
Public Sub SetFileSize (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
		'代码开始
		If Request.TotalBytes < 1 Then	'如果没有数据上传
			isErr_ = 1
			ErrMessage_="没有数据上传"
			Exit Sub
		End If
		If MaxSize > 0 Then '如果限制大小
                        FileSize_=Request.TotalBytes
			If Request.TotalBytes > MaxSize Then
			isErr_ = 2	'如果上传的数据超出限制大小
			ErrMessage_="上传的数据超出限制大小"
			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)
		'取得每个项目之间的分隔符
		sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
		iStart = LenB(sSpace)
		iFormStart = iStart+2
		'分解项目
		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			
			'取得表单项目名称
			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 clsFileInfo
				'取得文件属性
				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
			'如果是表单项目
				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
End Sub

'保存到文件,自动覆盖已存在的同名文件
Public Function SaveFile(Item,Path)
	SaveFile=SaveToFileEx(Item,Path,True)
End Function

'保存到文件,自动设置文件名
Public Function AutoSave(Item,Path)
	AutoSave=SaveToFileEx(Item,Path,false)
End Function

'保存到文件,OVER为真时,自动覆盖已存在的同名文件,否则自动把文件改名保存
Private Function SaveToFileEx(Item,Path,Over)
	On Error Resume Next
	Dim oFileStream
	Dim tmpPath
	Dim nohack '防黑缓冲
	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
	'nohack=split(path,"|") '重要修改，防止黑客二进制"01"断名!!!
	'tmpPath=nohack(0)&"."&nohack(ubound(nohack)) '重要修改，防止黑客二进制"01"断名!!!
	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()
				nohack=split(Path&GetNewFileName()&"."&File(Item).FileExt,"|") '重要修改，防止黑客二进'制"01"断名!!!
				'tmpPath=nohack(0)&"."&nohack(ubound(nohack)) '重要修改，防止黑客二进制"01"断名！！!
				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)
	'修改 获得图片高度宽度 
	Set PP = New ImgWHInfo  
    imgWidth_ = PP.imgW(tmpPath)  
    imgHeight_ = PP.imgH(tmpPath) 
	 Set pp = Nothing 
	  imgWidth_= imgWidth_
	   imgHeight_ = imgHeight_ 
End Function

'取得文件数据
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

'取得一个不重复的序号
Public Function GetNewFileName()
	dim ranNum
	dim dtNow
	dtNow=Now()
	ranNum=int(90000*rnd)+10000
	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
'----------------------------------------------------------------------------------------------------
'文件属性类
Class clsFileInfo
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class






Class ImgWHInfo '获取图片宽度和高度的类，支持JPG，GIF，PNG，BMP
    Dim ASO
    Private Sub Class_Initialize
        Set ASO=Server.CreateObject("ADODB.Stream")
        ASO.Mode=3
        ASO.Type=1
        ASO.Open
    End Sub
    Private Sub Class_Terminate
        Err.Clear
        Set ASO=Nothing
    End Sub 
 
    Private Function Bin2Str(Bin)
        Dim I, Str
        For I=1 To LenB(Bin)
            clow=MidB(Bin,I,1)
            If ASCB(clow)<128 Then
                Str = Str & Chr(ASCB(clow))
            Else
                I=I+1
                If I <= LenB(Bin) Then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
            End If
        Next
        Bin2Str = Str
    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 
      
    Private Function BinVal(Bin) 
        Dim Ret,I
        Ret = 0 
        For I = LenB(Bin) To 1 Step -1 
            Ret = Ret *256 + AscB(MidB(Bin,I,1)) 
        Next 
        BinVal=Ret 
    End Function 
      
    Private Function BinVal2(Bin) 
        Dim Ret,I
        Ret = 0 
        For I = 1 To LenB(Bin) 
            Ret = Ret *256 + AscB(MidB(Bin,I,1)) 
        Next 
        BinVal2=Ret 
    End Function 
      
    Private Function GetImageSize(filespec)
        Dim bFlag
        Dim Ret(3) 
        ASO.LoadFromFile(filespec) 
        bFlag=ASO.Read(3) 
        Select Case Hex(binVal(bFlag)) 
        Case "4E5089": 
            ASO.Read(15) 
            ret(0)="PNG" 
            ret(1)=BinVal2(ASO.Read(2)) 
            ASO.Read(2) 
            ret(2)=BinVal2(ASO.Read(2)) 
        Case "464947": 
            ASO.read(3) 
            ret(0)="gif" 
            ret(1)=BinVal(ASO.Read(2)) 
            ret(2)=BinVal(ASO.Read(2)) 
        Case "535746": 
            ASO.read(5) 
            binData=ASO.Read(1) 
            sConv=Num2Str(ascb(binData),2 ,8) 
            nBits=Str2Num(left(sConv,5),2) 
            sConv=mid(sConv,6) 
            While(len(sConv)<nBits*4) 
                binData=ASO.Read(1) 
                sConv=sConv&Num2Str(AscB(binData),2 ,8) 
            Wend 
            ret(0)="SWF" 
            ret(1)=Int(Abs(Str2Num(Mid(sConv,1*nBits+1,nBits),2)-Str2Num(Mid(sConv,0*nBits+1,nBits),2))/20) 
            ret(2)=Int(Abs(Str2Num(Mid(sConv,3*nBits+1,nBits),2)-Str2Num(Mid(sConv,2*nBits+1,nBits),2))/20) 
        Case "FFD8FF": 
            Do  
            Do: p1=binVal(ASO.Read(1)): Loop While p1=255 And Not ASO.EOS 
            If p1>191 And p1<196 Then Exit Do Else ASO.read(binval2(ASO.Read(2))-2) 
            Do:p1=binVal(ASO.Read(1)):Loop While p1<255 And Not ASO.EOS 
            Loop While True 
            ASO.Read(3) 
            ret(0)="JPG" 
            ret(2)=binval2(ASO.Read(2)) 
            ret(1)=binval2(ASO.Read(2)) 
        Case Else: 
            If left(Bin2Str(bFlag),2)="BM" Then 
                ASO.Read(15) 
                ret(0)="BMP" 
                ret(1)=binval(ASO.Read(4)) 
                ret(2)=binval(ASO.Read(4)) 
            Else 
                    ret(0)="" 
            End If 
        End Select 
        ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &"""" 
        getimagesize=ret 
    End Function 
      
    Public Function imgW(IMGPath)
        Dim FSO,IMGFile,FileExt,Arr
        Set FSO = Server.CreateObject("Scripting.FileSystemObject") 
        If (FSO.FileExists(IMGPath)) Then 
            Set IMGFile = FSO.GetFile(IMGPath) 
            FileExt=FSO.GetExtensionName(IMGPath) 
            Select Case FileExt 
                Case "gif","bmp","jpg","png": 
                Arr=GetImageSize(IMGFile.Path) 
                imgW = Arr(1) 
            End Select 
            Set IMGFile=Nothing 
        Else
            imgW = 0
        End If     
        Set FSO=Nothing 
    End Function 
     
    Public Function imgH(IMGPath)
        Dim FSO,IMGFile,FileExt,Arr
        Set FSO = server.CreateObject("Scripting.FileSystemObject") 
        If (FSO.FileExists(IMGPath)) Then 
            Set IMGFile = FSO.GetFile(IMGPath) 
            FileExt=FSO.GetExtensionName(IMGPath) 
            Select Case FileExt 
                Case "gif","bmp","jpg","png": 
                Arr=getImageSize(IMGFile.Path) 
                imgH = Arr(2) 
            End Select 
            Set IMGFile=Nothing 
        Else
            imgH = 0 
        End If     
        Set FSO=Nothing 
    End Function 
End Class
%>


