asp 无组件上传类

大佬教程收集整理的这篇文章主要介绍了asp 无组件上传类，大佬教程大佬觉得挺不错的，现在分享给大家，也给大家做个参考。

Dim StreamT
Class AnUpLoad
	Private Form,Fils
	Private vCharSet,vMaxSize,vSingleSize,vErr,vVersion,v@R_979_10586@lSize,vExe,pID,vOP
	
	Public Property Let MaxSize(ByVal value)
		vMaxSize = value
	End Property
	
	Public Property Let SingleSize(ByVal value)
		vSingleSize = value
	End Property
	
	Public Property Let Exe(ByVal value)
		vExe = LCase(value)
	End Property
	
	Public Property Let CharSet(ByVal value)
		vCharSet = value
	End Property
	
	Public Property Get ErrorID()
		ErrorID = vErr
	End Property
	
	Public Property Get Description()
		Description = GetErr(vErr)
	End Property
	
	Public Property Get Version()
		Version = vVersion
	End Property
	
	Public Property Get @R_979_10586@lSize()
		@R_979_10586@lSize = v@R_979_10586@lSize
	End Property
	
	Public Property Get ProcessID()
		ProcessID = pID
	End Property
	
	Public Property Let openProcesser(ByVal value)
		vOP = value
	End Property
	
	Private Sub Class_Initialize()
		set StreamT=server.createobject("ADODB.STREAM")
		set Form = server.createobject("ScripTing.Dictionary")
		set Fils = server.createobject("ScripTing.Dictionary")
		vVersion = "V9.9.9"
		vMaxSize = -1
		vSingleSize = -1
		vErr = -1
		vExe = ""
		v@R_979_10586@lSize = 0
		vCharSet = "utf-8"
		vOP=false
		pID="Upload"
		setApp "",""
	End Sub
	
	Private Sub Class_Terminate()
		Form.RemoveAll()
		Fils.RemoveAll()
		Set Form = Nothing
		Set Fils = Nothing
		Set StreamT = Nothing
	End Sub
	
	Public Sub GetData()
		If vMaxSize > 0 And request.@R_979_10586@lBytes > vMaxSize Then
			vErr = 1
			Exit Sub
		End If
		if vOP then pID=request.queryString("processid")
		Dim value,str,bcrlf,fpos,sSplit,slen,istart
		Dim @R_979_10586@lBytes,BytesRead,ChunkReadSize,PartSize,DataPart,temPDAta,formend,formhead,startpos,endpos,formname,Filename,fileExe,valueend,NewName,localname,type_1,contentType
		If checkEntryType = True Then
			v@R_979_10586@lSize = 0
			StreamT.Type = 1
			StreamT.Mode = 3
			StreamT.open
			@R_979_10586@lBytes = request.@R_979_10586@lBytes
			BytesRead = 0
			ChunkReadSize = 1024 * 36
			Do While BytesRead < @R_979_10586@lBytes
				PartSize = ChunkReadSize
				If PartSize + BytesRead > @R_979_10586@lBytes Then PartSize = @R_979_10586@lBytes - BytesRead
				DataPart = request.binaryRead(PartSizE)
				StreamT.Write DataPart
				BytesRead = BytesRead + PartSize
				setApp "uploading",@R_979_10586@lBytes,""
			Loop
			setApp "uploaded",""
			StreamT.Position = 0
			temPDAta = StreamT.Read
			bcrlf = ChrB(13) & ChrB(10)
			fpos = instrB(1,bcrlf)
			sSplit = MidB(temPDAta,1,fpos - 1)
			slen = LenB(sSplit)
			istart = slen + 2
			Do
				formend = instrB(istart,bcrlf & bcrlf)
				formhead = MidB(temPDAta,istart,formend - istart)
				str = Bytes2Str(formhead)
				startpos = instr(str,"name=""") + 6
				endpos = instr(startpos,"""")
				formname = LCase(Mid(str,endpos - startpos))
				valueend = instrB(formend + 3,sSplit)
				If instr(str,"filename=""") > 0 Then
					startpos = instr(str,"filename=""") + 10
					endpos = instr(startpos,"""")
					type_1=instr(endpos,lcase(str),"content-type")
					contentType=trim(mid(str,type_1+13))
					Filename = Mid(str,endpos - startpos)
					If Trim(FileName) <> "" Then
						LocalName = Filename
						Filename = @R_450_9363@ce(Filename,"/","\")
						Filename = Mid(Filename,instrRev(Filename,"\") + 1)
						setApp "processing",Filename
						If instr(Filename,".")>0 Then
							fileExe = Split(Filename,".")(UBound(Split(Filename,".")))
						else
							fileExe = ""
						End If
						If vExe <> "" Then
							If checkExe(fileExE) = True Then
								vErr = 3
								Exit Sub
							End If
						End If
						NewName = Getname()
						NewName = NewName & "." & fileExe
						v@R_979_10586@lSize = v@R_979_10586@lSize + valueend - formend - 6
						If vSingleSize > 0 And (valueend - formend - 6) > vSingleSize Then
							vErr = 5
							Exit Sub
						End If
						If vMaxSize > 0 And v@R_979_10586@lSize > vMaxSize Then
							vErr = 1
							Exit Sub
						End If
						If Fils.Exists(formname) Then
							vErr = 4
							Exit Sub
						Else
							Dim fileCls:set fileCls=New fileAction
							fileCls.ContentType=contentType
							fileCls.Size = (valueend - formend - 6)
							fileCls.Position = (formend + 3)
							fileCls.NewName = NewName
							fileCls.LocalName = Filename
							Fils.Add formname,fileCls
							Form.Add formname,LocalName
							Set fileCls = Nothing
						End If
					End If
				Else
					value = MidB(temPDAta,formend + 4,valueend - formend - 6)
					If Form.Exists(formname) Then
						Form(formname) = Form(formname) & "," & Bytes2Str(value)
					Else
						Form.Add formname,Bytes2Str(value)
					End If
				End If
				istart = valueend + 2 + slen
			Loop Until (istart + 2) >= LenB(temPDAta)
			vErr = 0
		Else
			vErr = 2
		End If
		setApp "processed",""
		if err then setApp "faild",err.description
	End Sub
	
	Public sub setApp(stp,@R_979_10586@l,current,desc)
		Application.lock()
		Application(pID)="{ID:""" & pID & """,step:""" & stp & """,@R_979_10586@l:" & @R_979_10586@l & ",now:" & current & ",description:""" & desc & """,dt:""" & now() & """}"
		Application.unlock()
	end sub
	
	Private Function checkExe(ByVal eX)
		Dim noTin: noTin = True
		If vExe="*" then
			noTin=false
		elseIf instr(1,"|") > 0 Then
			Dim tempExe: tempExe = Split(vExe,"|")
			Dim I: I = 0
			For I = 0 To UBound(tempExE)
				If LCase(eX) = tempExe(I) Then
					noTin = false
					Exit For
				End If
			Next
		Else
			If vExe = LCase(eX) Then
				noTin = false
			End If
		End If
		checkExe = noTin
	End Function
	
	Public Function GetSize(ByVal SizE)
		If Size < 1024 Then
			GetSize = Formatnumber(Size,2) & "B"
		ElseIf Size >= 1024 And Size < 1048576 Then
			GetSize = Formatnumber(Size / 1024,2) & "KB"
		ElseIf Size >= 1048576 Then
			GetSize = Formatnumber((Size / 1024) / 1024,2) & "MB"
		End If
	End Function
	
	Private Function Bytes2Str(ByVal byt)
		If LenB(byt) = 0 Then
			Bytes2Str = ""
			Exit Function
		End If
		Dim mystream,bstr
		Set mystream =server.createobject("ADODB.Stream")
		mystream.Type = 2
		mystream.Mode = 3
		mystream.Open
		mystream.WriteText byt
		mystream.Position = 0
		mystream.CharSet = vCharSet
		mystream.Position = 2
		bstr = mystream.ReadText()
		mystream.Close
		Set mystream = Nothing
		Bytes2Str = bstr
	End Function
	
	Private Function GetErr(ByVal Num)
		SELEct Case Num
		Case 0
			GetErr = "数据处理完毕!"
		Case 1
			GetErr = "上传数据超过" & GetSize(vMaxSizE) & "限制!可设置MaxSize属性来改变限制!"
		Case 2
			GetErr = "未设置上传表单enctype属性为multipart/form-data或者未设置method属性为Post,上传无效!"
		Case 3
			GetErr = "含有非法扩展名文件!只能上传扩展名为" & @R_450_9363@ce(vExe,"|",",") & "的文件"
		Case 4
			GetErr = "对不起,程序不允许使用相同name属性的文件域!"
		Case 5
			GetErr = "单个文件大小超出" & GetSize(vSingleSizE) & "的上传限制!"
		End SELEct
	End Function
	
	Private Function Getname()
		Dim y,m,d,h,mm,S,r
		Randomize
		y = Year(Now)
		m = Month(Now): If m < 10 Then m = "0" & m
		d = Day(Now): if D < 10 Then d = "0" & d
		h = Hour(Now): If h < 10 Then h = "0" & h
		mm = minute(Now): If mm < 10 Then mm = "0" & mm
		S = Second(Now): If S < 10 Then S = "0" & S
		r = 0
		r = CInt(Rnd() * 1000)
		If r < 10 Then r = "00" & r
		If r < 100 And r >= 10 Then r = "0" & r
		Getname = y & m & d & h & mm & S & r
	End Function
	
	Private Function checkEntryType()
		Dim ContentType,ctArray,bArray,requestMethod
		requestMethod=trim(LCase(request.ServerVariables("requEST_METHOD")))
		if requestMethod="" or requestMethod<>"post" then
			checkEntryType = false
			exit function
		end if
		ContentType = LCase(request.ServerVariables("http_CONTENT_TYPE"))
		ctArray = Split(ContentType,";")
		if ubound(ctarray)>=0 then
			If Trim(ctArray(0)) = "multipart/form-data" Then
				checkEntryType = True
			Else
				checkEntryType = false
			End If
		else
			checkEntryType = false
		end if
	End Function
	
	Public Function Forms(ByVal formname)
		If trim(formname) = "-1" Then
			Set Forms = Form
		Else
			If Form.Exists(LCase(formname)) Then
				Forms = Form(LCase(formname))
			Else
				Forms = ""
			End If
		End If
	End Function
	
	Public Function Files(ByVal formname)
		If trim(formname) = "-1" Then
			Set Files = Fils
		Else
			If Fils.Exists(LCase(formname)) Then
				Set Files = Fils(LCase(formname))
			Else
				Set Files = Nothing
			End If
		End If
	End Function
	
	Public Function SaveAs(ByVal formname,ByVal path,ByVal saveType )
		dim vfileAction
		set vfileAction=Files(formname)
		if vfileAction.Filename<>"" then
			if vfileAction.SaveToFile(path,saveTypE) then
				SaveAs=vfileAction.Filename
			else
				SaveAs="Has Error!"
			end if
		end if
		set vfileAction=nothing
	end function
End Class

Class fileAction
	Private vSize,vPosition,vName,vNewName,vLocalName,vPath,savename,vContentType
	
	Public Property Let NewName(ByVal value)
		vNewName = value
	End Property
	
	Public Property Get NewName()
		NewName = vNewName
	End Property
	
	Public Property Let ContentType(vData)
		vContentType = vData
	End Property
	
	Public Property Get ContentType()
		ContentType = vContentType
	End Property
	
	Public Property Let LocalName(ByVal value)
		vLocalName = value
		vName = value
	End Property
	
	Public Property Get LocalName()
		LocalName = vLocalName
	End Property
	
	Public Property Get Filename()
		Filename = vName
	End Property
	
	Public Property Let Position(ByVal value)
		vPosition = value
	End Property
	
	Public Property Let Size(ByVal value)
		vSize = value
	End Property
	
	Public Property Get Size()
		Size = vSize
	End Property
	
	Public Function SaveToFile(ByVal path,ByVal saveTypE)
		On Error Resume Next
		Err.Clear
		vPath = @R_450_9363@ce(path,"\")
		If Right(vPath,1) <> "\" Then vPath = vPath & "\"
		CreateFolder vPath
		Dim mystream
		Set mystream =server.createobject("ADODB.Stream")
		mystream.Type = 1
		mystream.Mode = 3
		mystream.Open
		StreamT.Position = vPosition
		StreamT.CopyTo mystream,vSize
		vName = vNewName
		If saveType = 1 Then vName = vLocalName
		mystream.SaveToFile vPath & vName,2
		mystream.Close
		Set mystream = Nothing
		If Err Then
			SaveToFile = false
		Else
			SaveToFile = True
		End If
	End Function
	
	Public Function GetBytes()
		StreamT.Position = vPosition
		GetBytes = StreamT.Read(vSizE)
	End Function
	
	Private Function CreateFolder(ByVal FolderPath)
		on error resume next
		Dim FolderArray
		Dim i
		Dim DiskName
		Dim Created
		Dim FSO : Set FSO = Server.CreateObject("ScripTing.FileSystemObject")
		If FSO.FolderExists(FolderPath) Then
			Set Fso = Nothing
			Exit Function
		End If
		FolderPath = @R_450_9363@ce(FolderPath,"\")
		If Mid(FolderPath,Len(FolderPath),1) = "\" Then FolderPath = Mid(FolderPath,Len(FolderPath) - 1)
		FolderArray = Split(FolderPath,"\")
		DiskName = FolderArray(0)
		Created = DiskName
		For i = 1 To UBound(FolderArray)
			Created = Created & "\" & FolderArray(i)
			If Not FSO.FolderExists(Created) Then FSO.CreateFolder Created
		Next
		Set FSO = Nothing
		err.clear
	End Function
End Class

大佬总结

以上是大佬教程为你收集整理的asp 无组件上传类全部内容，希望文章能够帮你解决asp 无组件上传类所遇到的程序开发问题。

如果觉得大佬教程网站内容还不错，欢迎将大佬教程推荐给程序员好友。

本图文内容来源于网友网络收集整理提供，作为学习参考使用，版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ：384754419，请注明来意。