<%
'无组件文件上传 ver2.11

'上传类
Class Upload
	Private arrData
	Private stmRequest
	Private objData
	Private m_blnCaseSensitive
	Private Sub Class_Initialize '构造函数（初始化数据）
		dim intFileSize,binFileData
		intFileSize = Request.totalbytes               '客户端响应数据字节的大小
		m_blnCaseSensitive = false
		'没有数据退出处理
		if intFileSize = 0 then
			exit sub
		end if
		set stmRequest = CreateObject("Adodb.Stream")
		With stmRequest
			.Mode = 3
			.Type = 1
			.Open
			.Write Request.BinaryRead(intFileSize)  '得到数据量要小于或等于totalbytes
			.Position = 0
			binFileData = .Read '将数据流赋值给变量 binFileData
		End With
		if lenB(binFileData)=0 then exit sub

		'取得分割字符串
		dim binCrLf,binDivider,intDividerLen
		binCrLf = chrB(13) & chrB(10)
		if instrB(binFileData,binCrLf) - 1 < 0 then exit sub '如果没有binCrLf退出循环
		binDivider = leftB(binFileData,instrB(binFileData,binCrLf) - 1)
		intDividerLen=lenB(binDivider) + 2
	
		'将上传数据成组分割
		dim intStartPoint,intEndPoint,binBlock,intLoop
		set objData = Server.CreateObject("Scripting.Dictionary")
		intStartPoint = 1
		intLoop = 0
		do
			intEndPoint = instrB(intStartPoint + 1,binFileData,binDivider,0)
			if intEndPoint = 0 then exit do
			binBlock = midB(binFileData,intStartPoint + intDividerLen,intEndPoint - intStartPoint - intDividerLen)
			'*********************************分解数据***********************************************
			objData.Add intLoop,splitData(binBlock,intStartPoint + intDividerLen)
			'*********************************分解数据结束***********************************************
			intStartPoint = intEndPoint
			intLoop = intLoop + 1
		Loop
		'将所有数据放入arrData数组
		arrData = objData.Items
	End Sub
	
	Private Sub Class_Terminate  '析构函数（释放内存数据）
		dim intLoop
		objData.RemoveAll
		
		set objData = nothing
		for intLoop = Lbound(arrData) to Ubound(arrData)
			set arrData(intLoop) = nothing
		next
		stmRequest.close
		set stmRequest=nothing
	End Sub
	'设置区分大小写属性
	Public Property Get CaseSensitive()
		CaseSensitive = m_blnCaseSensitive
	End Property
	Public Property Let CaseSensitive(blnData)
		 m_blnCaseSensitive = blnData 
	End Property
	'将二进制数据转化为对象
	Private Function splitData(binData,intBlockStart)
		dim binCrLf,intPoint,clsData,binName,binValue,intBinStart
		binCrLf = chrB(13) & chrB(10)
		intPoint = instrB(binData,binCrLf & binCrLf)
		binName = leftB(binData,intPoint-1)
		if lenB(binData)-intPoint-5 > 0 then
			binValue = midB(binData,intPoint+4,lenB(binData)-intPoint-5)
			intBinStart = intBlockStart + intPoint + 2
		end if
		dim intStartPoint,intCount
		intStartPoint = 0
		intCount = 0
		do while(instrB(intStartPoint + 1,binName,chrb(asc(";"))))
			intStartPoint = instrB(intStartPoint + 1,binName,chrb(asc(";")))
			intCount = intCount + 1
		loop  
		set clsData = new FormItem
		if intCount > 1 then
			clsData.DataType = 1 '二进制为1
		else
			clsData.DataType = 0 '文本为0
		end if
		dim binDivider,intStart,intLen
		binDivider = chrb(Asc(";")) & chrb(Asc(" ")) & chrb(Asc("n")) &  chrb(Asc("a")) & chrb(Asc("m")) & chrb(Asc("e")) & chrb(Asc("=")) & chrb(Asc(""""))
		intPoint = instrB(binName,binDivider)
		intStart = intPoint + 8
		intLen = instrB(intStart,binName, chrb(Asc(""""))) - intStart
		clsData.Name = bintoStr(midB(binName,intStart,intLen))
		clsData.Start = intBinStart
		if clsData.DataType then 
			if lenB(binValue) mod 2 <> 0 then 
				clsData.Value = binValue & chrB(0)
			else
				clsData.Value = binValue
			end if
			binDivider = chrb(Asc(";")) & chrb(Asc(" "))  & chrb(Asc("f")) &  chrb(Asc("i")) & chrb(Asc("l")) & chrb(Asc("e")) & chrb(Asc("n")) &  chrb(Asc("a")) & chrb(Asc("m")) & chrb(Asc("e")) & chrb(Asc("=")) & chrb(Asc(""""))
			intPoint = instrB(binName,binDivider)
			intStart = intPoint + 12
			intLen = instrB(intStart,binName, chrb(Asc(""""))) - intStart
			clsData.FileName = bintoStr(midB(binName,intStart,intLen))
			binDivider = binCrLf & chrb(Asc("C")) & chrb(Asc("o"))  & chrb(Asc("n")) &  chrb(Asc("t")) & chrb(Asc("e")) & chrb(Asc("n")) & chrb(Asc("t")) &  chrb(Asc("-")) & chrb(Asc("T")) & chrb(Asc("y")) & chrb(Asc("p")) & chrb(Asc("e"))
			intPoint = instrB(binName,binDivider)
			intStart = intPoint + 16
			clsData.ContentType = bintoStr(midB(binName,intStart))
		else
			clsData.Value = bintoStr(binValue)
		end if
		set splitData = clsData
	End Function
	
	'转化二进制数据为字符串
	Private Function bintoStr(binStr)
		Dim intUnicodeLow,strReturn,blnSkipFlag,intLoop
		'双字节字符Skip标志
		blnSkipFlag = false
		strReturn = ""
		If lenB(binStr) Then
			For intLoop=1 To LenB(binStr)
				If blnSkipFlag Then
					blnSkipFlag = false
				Else
					intUnicodeLow = MidB(binStr,intLoop,1)
					'判断是否双字节的字符
					If AscB(intUnicodeLow) > 127 Then
						'AscW会把二进制的双字节字符高位和低位反转，所以要先把双字节的高低位反转
						strReturn =strReturn & Chr(AscW(MidB(binStr,intLoop+1,1) & intUnicodeLow))
						blnSkipFlag = true
					Else
						strReturn = strReturn & Chr(AscB(intUnicodeLow))
					End If
				End If
			Next
		End If
		bintoStr = strReturn
	End Function
	'************************************************接口函数开始**********************************************************
	'读取数据Class
	Public Function binRequest(strName,intNum)
		dim blnExists,intCount,intLoop
		intCount = 0
		if isEmpty(arrData) then
			set binRequest = new FormItem
			exit function
		end if
		for intLoop = 0 to ubound(arrData)
			if not isObject(arrData(intLoop)) then exit for
			if m_blnCaseSensitive then '如果大小写敏感
				if strName = arrData(intLoop).Name then
					if intCount = intNum then
						blnExists = true
						exit for
					end if
					intCount = intCount + 1
				end if
			else
				if UCase(strName) = UCase(arrData(intLoop).Name)then
					if intCount = intNum then
						blnExists = true
						exit for
					end if
					intCount = intCount + 1
				end if
			end if
		next
		if blnExists then
			set binRequest = arrData(intLoop)
		else
			set binRequest = new FormItem
		end if
	End Function
	
	'判断存在个数
	Public Function binCount(strName)
		dim intCount,intLoop
		intCount = 0
		if isEmpty(arrData) then
			binCount = intCount
			exit function
		end if
		for intLoop = 0 to ubound(arrData)
			if not isObject(arrData(intLoop)) then exit for
			if m_blnCaseSensitive then '如果大小写敏感
				if strName = arrData(intLoop).Name then
					intCount = intCount + 1
				end if
			else
				if UCase(strName) = UCase(arrData(intLoop).Name) then
					intCount = intCount + 1
				end if
			end if			
		next
		binCount = intCount
	End Function
	
	'判断是否存在
	Public Function isExists(strName)
		dim blnExists,intLoop
		blnExists = false
		if isEmpty(arrData) then
			isExists = blnExists
			exit function
		end if
		for intLoop = 1 to ubound(arrData)
			if not isObject(arrData(intLoop)) then exit for
			if m_blnCaseSensitive then '如果大小写敏感
				if strName = arrData(intLoop).Name then
					blnExists = true
					exit for
				end if
			else
				if UCase(strName) = UCase(arrData(intLoop).Name) then
					blnExists = true
					exit for
				end if
			end if
		next
		isExists = blnExists
	End Function
	
	'保存到文件
	Public Function SavetoFile(strName,intNum,strFullName,blnForce)
		dim clsData
		set clsData = binRequest(strName,intNum)
		If IsEmpty(binRequest(strName,intNum).DataType) Then
			SavetoFile = 1 '该控件不存在
			Exit Function
		End if
		If len(binRequest(strName,intNum).value) = 0 Then
			SavetoFile = 2 '该控件值为空
			Exit Function
		End If
		dim objFSO
		set objFSO = server.CreateObject("Scripting.FileSystemObject")
		if not objFSO.FolderExists(GetPath(strFullName)) then
			SavetoFile = 4 '保存路径的目录不存在
			Exit Function
		end if
		set objFSO = nothing
		
		dim stmData
		set stmData = Server.CreateObject("ADODB.Stream")
		with stmData
			.Mode = 3 'adModeWrite; 4 adModeReadWrite; 1 adModeRead （默认值）
			.Type = 1 'adTypeBinary
			.Open
			dim objFs 
			set objFs = server.CreateObject("Scripting.FileSystemObject")
			if blnForce then
				stmRequest.Position = clsData.Start
				stmRequest.Copyto stmData,lenB(clsData.value)
				on Error Resume Next
				.SavetoFile strFullName,2 'adSaveCreateOverWrite 
				if Err <> 0 then
					if objFs.FileExists(strFullName) then
						SavetoFile = 8 '文件不能保存，该文件正在被使用
					else
						SavetoFile = 16 '文件不能保存，请确定该目录具有可写权限
					end if
				else
					SavetoFile = 0
				End if
				on Error goto 0
			else
				if objFs.FileExists(strFullName) then
					SavetoFile = 32 '非强制覆盖状态，文件已经存在
				else
					stmRequest.position = clsData.Start
					stmRequest.copyto stmData,lenB(clsData.value)
					on Error Resume Next
					.SavetoFile strFullName,2 'adSaveCreateOverWrite 
					if Err <> 0 then
						SavetoFile = 16 '文件不能保存，请确定该目录具有可写权限
					else
						SavetoFile = 0
					End if
					on Error goto 0
				end if
			end if
			set objFs = nothing
			.close
		end with
		set stmData = nothing
	End Function
	Function GetPath(strFullName)
		dim strReturn
		strReturn = left(strFullName,InstrRev(strFullName,"\"))
		GetPath = strReturn
	End function
	'************************************************接口函数结束**********************************************************
	
End Class

'定义数据类（存放form数据）
class FormItem
	Private mName
	Private mValue
	Private mType '数据类型：二进制数据取1； 文本数据取0
	Private mFileName
	Private mContentType
	Private mStart '二进制数据的开始结束位置
	'*************属性设置开始********************************
	Public Property Get Name()
		name = mName
	end Property
	Public Property Let Name(byVal varData)
		mName = varData
	end Property
	Public Property Get Value()
		value = mValue
	end Property
	Public Property Let Value(byVal varData)
		mValue = varData
	end Property
	Public Property Get DataType()
		DataType = mType
	end Property
	Public  Property Let DataType(byVal varData)
		mType = varData
	end Property
	Public Property Get FileName()
		FileName = mFileName
	end Property
	Public Property Let FileName(byVal varData)
		mFileName = varData
	end Property
	Public Property Get ContentType()
		ContentType = mContentType
	end Property
	Public Property Let ContentType(byVal varData)
		mContentType = varData
	end Property
	Public Property Get Start()
		Start = mStart
	end Property
	Public Property Let Start(byVal varData)
		mStart = varData
	end Property
	'取得文件名
	Public Property Get  ShortFileName()
		dim strReturn
		strReturn = Mid(mFileName,InstrRev(mFileName,"\")+1)
		ShortFileName = strReturn
	End Property
	'*************属性设置结束********************************
	'******************私有函数开始******************************
	'返回高位在后的整数（Intel顺序）
	Private Function ConvertIntel(strTemp)
		dim i
		for i = 1 to lenB(strTemp)
			ConvertIntel = ConvertIntel + ascb( midb( strTemp, i, 1 ) ) * ( 2 ^ ( (i-1) * 8 ) )
		next
	end Function
	'返回高位在前的整数（Motorola顺序）
	Private Function ConvertMotorola(strTemp)
		dim i,j
		j = 0
		for i = lenB(strTemp) to 1 step -1
			ConvertMotorola = ConvertMotorola + ascb( midb( strTemp, i, 1 ) ) * ( 2 ^ ( j * 8 ) )
			j = j + 1
		next
	end Function
	
	'******************私有函数结束******************************
	
	'****************************************接口函数开始***************************************
		
	'处理图片信息
	Public Function IsImage(byRef imgWidth,byRef imgHeight,byRef imgType,byRef imgSize,byRef imgBit)
		if mType = 0 or LenB(mValue) = 0 then
			IsImage = false
			imgWidth  = -1
			imgHeight = -1
			imgType = "unknow"
			imgSize = -1
			imgBit = -1
			exit function
		end if
		
	  	dim flag
	  	flag = 0  '0 is not jpg/gif/png image; 1 is jpg/gif/png



	    '*********************************Check.jpg Start*****************************************************
		dim i_Depth
		if flag = 0 then 
			dim lngMarkerSize,lngSize,flgFound,strTarget,lngpos,exitLoop
			'tempstr = LeftB(mValue,10)
			'tstr = chrb(255) & chrb(216) & chrb(255) & chrb(224) & chrb(0) & chrb(16) & chrb(74) & chrb(70) & chrb(73) & chrb(70)
			'if strcomp(tempstr,tstr,0) = 0 then
			flgFound = 0
			strTarget = chrb(255) & chrb(216) & chrb(255)
			flgFound = instrb(mValue, strTarget)
			if flgFound<>0 then
				imgType = "JPG" '图片格式
				imgSize = lenB(mValue) '图片大小
				lngSize = imgSize
				'strTarget = chrb(255) & chrb(216) & chrb(255)
				'flgFound = instrb(mValue, strTarget)
				lngPos = flgFound + 2
				ExitLoop = false
		
				do while ExitLoop = False and lngPos < lngSize
					do while ascb(midb(mValue, lngPos, 1)) = 255 and lngPos < lngSize
						lngPos = lngPos + 1
					loop
					if ascb(midb(mValue, lngPos, 1)) < 192 or ascb(midb(mValue, lngPos, 1)) > 195 then
						lngMarkerSize = ConvertMotorola(midb(mValue, lngPos + 1, 2))
						lngPos = lngPos + lngMarkerSize + 1
		      		else
		        		ExitLoop = True
					end if
				loop
				imgHeight = ConvertMotorola(midb(mValue,  lngPos +4, 2)) '图片高度
				imgWidth = ConvertMotorola(midb(mValue, lngPos +6, 2)) '图片宽度
		    	imgBit = ascb(midb(mValue, lngPos + 8, 1)) * 8 '图片色深
		    	flag=2
			else
				flag=0
			end if
		end if
		'*********************************Check.jpg End*****************************************************

		'*********************************Check.gif Start*****************************************************
		if flag = 0 then
			dim tstr2
			tempstr = Leftb(mValue,6)
			tstr = chrb(71) & chrb(73) & chrb(70) & chrb(56) & chrb(57) & chrb(97)
			tstr2 = chrb(71) & chrb(73) & chrb(70) & chrb(56) & chrb(55) & chrb(97)
			if (strcomp(tempstr,tstr,0) = 0 or strcomp(tempstr,tstr2) = 0) and (lenB(mValue) > 12) then
				imgType = "gif" '图片格式
				imgWidth = ConvertIntel(midb(mValue,7,2))  '图片宽度
				imgHeight = ConvertIntel(midb(mValue,9,2)) '图片高度
				imgBit = (ascb(midb(mValue, 11, 1)) and 112)/16 + 1 '图片色深
				imgSize = lenB(mValue) '图片大小
				flag = 2
			else 
				flag = 0
			end if
		end if
		'*********************************Check.gif End*****************************************************
		
		'*********************************Check.bmp Start*****************************************************
		if flag = 0 then
			tempstr = Leftb(mValue,2)
			tstr = chrb(Asc("B")) & chrb(Asc("M"))
			if (strcomp(tempstr,tstr,0) = 0) and (lenb(mValue) >32 ) then
				imgType = "bmp" '图片格式
				imgWidth = ConvertIntel(midb(mValue,19,4))  '图片宽度
				imgHeight = ConvertIntel(midb(mValue,23,4)) '图片高度
				imgBit = ConvertIntel(midb(mValue,29,2)) '图片色深
				imgSize = lenB(mValue) '图片大小
				flag=2
			else 
				flag=0
			end if
		end if
		'*********************************Check.bmp End*****************************************************
		
		'*********************************Check.png Start*****************************************************
		if flag = 0 then 
			dim i_colorType
			tempstr=Leftb(mValue,8)
			tstr=chrb(137) & chrb(80) & chrb(78) & chrb(71) & chrb(13) & chrb(10) & chrb(26) & chrb(10)
			if (strcomp(tempstr,tstr,0) = 0) and (lenb(mValue) >27 )then
				imgType = "png" '图片格式
				imgWidth  = ConvertMotorola(midb(mValue, 19, 2)) '图片宽度
				imgHeight = ConvertMotorola(midb(mValue, 23, 2)) '图片高度
				i_Depth  = ascb(midb(mValue, 25, 1))
				i_colorType = ascb(midb(mValue, 26, 1))
				select case i_colorType
					case 0
						i_Depth = i_Depth
					case 2
						i_Depth = i_Depth * 3
					case 3
						i_Depth = i_Depth
					case 4
						i_Depth = i_Depth * 2
					case 6
						i_Depth = i_Depth * 4
					case else
						i_Depth = -1
				end select
				imgBit = i_Depth '图片色深
				imgSize = lenB(mValue) '图片大小
				flag = 2
			else 
				flag = 0
			end if
		end if
		
		'*********************************Check.png End*****************************************************
		if flag = 0 then 
			isImage = false
			imgWidth  = -1
			imgHeight = -1
			imgType = "unknow"
			imgSize = -1
			imgBit = -1
		else
			IsImage = true
		end if
	End Function
	'*************************************************接口函数结束***********************************************
end class

%>