upload.asp

酷虎网同学录V1.0

<%
'无组件文件上传 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")