upload.asp

本示例综合展示了NTKO OFFICE文档控件所具有的发布为HTML

<%
'处理文件上传的组件类定义。@Copyright By 软航科技,千航网络
'说明：该类定义了一个能够处理包含上传文件的FORM数据
'的组件。
'**************************************************
'FileUploader类 处理上载和解析HTML FORM
'方法:
' Upload() :必须首先被调用。该方法将读取所有的输入数据并
'           解析。
'属性:
' Files    :上传的所有文件。是一个Scripting.Dictionary类
'           其成员是UploadedFile 类型的对象。 
' Form("inputname"): 可以用此方法获取FORM中的输入值。
'           比如： Form("docid")将获取html页面中<input ... name="docid">中输入的值
' FormInputs:表单中所有输入的集合，是一个Scripting.Dictionary类
'			其成员是FormInput类型的对象。 
'**************************************************
'UploadedFile类表示一个上载的文件
' 属性:
' UploadedFile.ContentType: 文件的MIME类型
' UploadedFile.InputName: html文件中<input type=file name="xx">的name的值，此处为"xx"
' UploadedFile.FileName:  上传文件的文件名
' UploadedFile.FileData:  文件数据
' UploadedFile.FileSize:  文件大小（字节）
' 方法: 
'     SaveToDatabase(ByRef oField) 将文件数据保存到数据集的一个字段（BLOB类型）。
'           比如：File.SaveToDatabase RS("filedata")
' 函数:
'     status = SaveToDisk(sPath) 将文件数据保存到磁盘 参数是目录名，返回状态
'**************************************************
'FormInput类表示HTML FORM中的一个<input>类型
' 属性:
' InputName: input的name
' InputValue: input的值

Class FileUploader
	Public	FormCharSet
	Public  Files
	Public	FormInputs

	Private Sub Class_Initialize()
		Set Files = Server.CreateObject("Scripting.Dictionary")
		Set FormInputs = Server.CreateObject("Scripting.Dictionary")
		FormCharSet = "gb2312"
	End Sub
	
	Private Sub Class_Terminate()
		If IsObject(Files) Then
			Files.RemoveAll()
			Set Files = Nothing
		End If
		If IsObject(FormInputs) Then
			FormInputs.RemoveAll()
			Set FormInputs = Nothing
		End If
	End Sub

	'获取第一个名称为sIndex的输入域的值
	Public Property Get Form(sIndex)
		Form = ""
		For	Each oFormInput In FormInputs.Items
			If (LCase(oFormInput.InputName)=LCase(sIndex)) Then 
				Form = oFormInput.InputValue
				Exit For
			End if
		Next
	End Property

	Public Default Sub Upload()
		dim sCome
		Dim biData, sInputName
		Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
		Dim nPosFile, nPosBound

		set sCome = Server.CreateObject("ADODB.Stream")

		sCome.Type = 1  '指定返回数据类型 adTypeBinary=1,adTypeText=2
		sCome.Mode = 3  '指定打开模式 adModeRead=1,adModeWrite=2,adModeReadWrite=3
		sCome.Open
		
		dim readbytes 
		readbytes = 0
		dim toread 
		toread = 10000
		'读入所有输入数据
		while (readbytes + toread < request.TotalBytes)
			sCome.Write request.BinaryRead(toread)
			readbytes = readbytes + toread
		wend		
		sCome.Write request.BinaryRead(request.TotalBytes-readbytes)
		
		sCome.Position = 0
		biData = sCome.Read

		nPosBegin = 1
		nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
		
		If (nPosEnd-nPosBegin) <= 0 Then Exit Sub
		 
		vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
		nDataBoundPos = InstrB(1, biData, vDataBounds)
		
		Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))
			
			nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
			nPos = InstrB(nPos, biData, CByteString("name="))
			nPosBegin = nPos + 6
			nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
			sInputName = CTextfromBin(sCome,nPosBegin,nPosEnd-nPosBegin)
			nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
			nPosBound = InstrB(nPosEnd, biData, vDataBounds)
			
			If nPosFile <> 0 And  nPosFile < nPosBound Then
				Dim oUploadFile, sFileName
				Set oUploadFile = New UploadedFile
				
				oUploadFile.InputName = sInputName
				
				nPosBegin = nPosFile + 10
				nPosEnd =  InstrB(nPosBegin, biData, CByteString(Chr(34)))
				sFileName = CTextfromBin(sCome,nPosBegin,nPosEnd-nPosBegin)
	
				oUploadFile.FileName = Mid(sFileName,instrrev(sFileName,"\")+1)							

				nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
				nPosBegin = nPos + 14
				nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
				
				oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
				
				nPosBegin = nPosEnd+4
				nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2

				sCome.Position = nPosBegin -1
				oUploadFile.FileData  = sCome.Read(nPosEnd-nPosBegin)
				
				If oUploadFile.FileSize > 0 Then 
					Files.Add  Cstr(Files.Count), oUploadFile
				End if
				
			Else
				nPos = InstrB(nPos, biData, CByteString(Chr(13)))
				nPosBegin = nPos + 4
				nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
				Dim oFormInput
				set oFormInput = New FormInput
				oFormInput.InputName = sInputName
				oFormInput.InputValue = CTextfromBin(sCome,nPosBegin,nPosEnd-nPosBegin)
				FormInputs.Add Cstr(FormInputs.Count), oFormInput
			End If

			nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
		Loop
	End Sub

	'String to byte string conversion
	Private Function CByteString(sString)
		Dim nIndex
		For nIndex = 1 to Len(sString)
		   CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
		Next
	End Function

	'Byte string to string conversion
	Private Function CWideString(bsString)
		Dim nIndex
		CWideString =""
		For nIndex = 1 to LenB(bsString)
		   CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1))) 
		Next
	End Function
	
	Private function CTextfromBin(srmSource,posBegin,posLen)
		dim srmObj, strData
		set srmObj = server.CreateObject("adodb.stream")
		srmObj.Type = 1
		srmObj.Mode = 3
		srmObj.Open

		srmSource.position = posBegin-1		'位置计数首数不一样，这个对象是对0开始的
		srmSource.CopyTo srmObj,posLen
		srmObj.Position = 0
		srmObj.Type = 2
		srmObj.Charset = FormCharSet
		strData = srmObj.ReadText 
		
		srmObj.Close 
		set srmObj = nothing
		
		CTextfromBin = strData
	end function

End Class

//上传的文件类
Class UploadedFile
	Public ContentType
	Public InputName
	Public FileName
	Public FileData
	
	Public Property Get FileSize()
		FileSize = LenB(FileData)
	End Property

	Public Function SaveToDisk(sPath)
		dim sCome
		dim oFS
		Set oFS = Server.CreateObject("Scripting.FileSystemObject")
		If Not oFS.FolderExists(sPath) Then 
			SaveToDisk = "目录" & sPath & "不存在。"
			Exit Function
		End if
		If sPath = "" Or FileName = "" Then 
			SaveToDisk = "保存错误。"
			Exit Function
		End if
		If ( (Instr(FileName,"\") <> 0 ) or ( Instr(FileName,"/")<>0 ) ) Then
			SaveToDisk = "错误的文件名。"
			Exit Function
		End if
		If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
		
		set sCome = Server.CreateObject("ADODB.Stream")
		sCome.Type = 1  '指定返回数据类型 adTypeBinary=1,adTypeText=2
		sCome.Mode = 3  '指定打开模式 adModeRead=1,adModeWrite=2,adModeReadWrite=3
		sCome.Open
		
		sCome.Write FileData
		
		sCome.SaveToFile (sPath & FileName),2
		sCome.Close 
		set sCome = Nothing
		SaveToDisk = "保存成功。"
	End Function
	
	Public Sub SaveToDatabase(ByRef oField)
		If LenB(FileData) = 0 Then Exit Sub
		
		If IsObject(oField) Then
			oField.AppendChunk FileData
		End If
	End Sub

End Class

//上传的文件类
Class FormInput
	Public InputName
	Public InputValue
End Class
%>