No fear Upload class modified version ASP

<%option explicit%>
<%
Class Clsup ' File upload classes
‘------------------------
Dim Form,file
Dim allowext_ ' Allow upload type (white list)
Dim noallowext_ ' do not allow upload type (blacklist)
Private Oupfilestream ' uploaded data stream
Private iserr_ ' wrong code, 0 or True indicates error-free
Private Errmessage_ ' ERROR string information
Private Isgetdata_ ' Indicates whether the GetData process has been performed

‘------------------------------------------------------------------
' Properties of the class
Public Property Get Version
version= "Pioneer Upload class (No fear to improve Security edition) version 2.0"
End Property

Public property Get iserr ' wrong code, 0 or True indicates error-free
Iserr=iserr_
End Property

Public Property Get Errmessage ' Error string information
Errmessage=errmessage_
End Property

Public property Get allowext ' Allow upload type (whitelist)
Allowext=allowext_
End Property

Public property lets Allowext (Value) ' Allow upload type (whitelist)
Allowext_=lcase (Value)
End Property

Public property Get Noallowext ' Do not allow upload type (blacklist)
Noallowext=noallowext_
End Property

Public Property Let Noallowext (Value) ' does not allow upload type (blacklist)
Noallowext_=lcase (Value)
End Property

‘----------------------------------------------------------------
' Class implementation code

' Initialize class
Private Sub Class_Initialize
Iserr_ = 0
Noallowext= "" ' Blacklist, you can preset a non-uploading file type, with the suffix of the file to judge, no case, each prefix name, separate, if the blacklist is empty, then the white list is judged
Noallowext=lcase (Noallowext)
allowext= "" ' White list, you can preset the type of file can be uploaded here, with the suffix name of the file to judge, no case, each suffix name;
Allowext=lcase (Allowext)
Isgetdata_=false
End Sub

' Class end
Private Sub Class_Terminate
On Error Resume Next
' Clear variables and the image
Form.removeall
Set Form = Nothing
File.removeall
Set File = Nothing
Oupfilestream.close
Set Oupfilestream = Nothing
End Sub

' Analyze the uploaded data
Public Sub GetData (MaxSize)
' Define variables
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
' Code started
If request.totalbytes < 1 Then ' if there is no data upload
Iserr_ = 1
errmessage_= "No data Upload"
Exit Sub
End If
If MaxSize > 0 Then ' if limit size
If request.totalbytes > MaxSize Then
Iserr_ = 2 ' If the uploaded data exceeds the limit size
Errmessage_= "The uploaded data exceeds the limit size"
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 ($) & ChrB (10)
' Get the delimiter between each item
Sspace = MidB (requestbindate,1, InStrB (1,REQUESTBINDATE,BCRLF)-1)
IStart = LenB (sspace)
Iformstart = istart+2
' Decomposition project
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
' Get form Item name
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 it is a file
If InStr (45,sinfo, "filename=" "", 1) > 0 Then
Set ofileinfo = new Clsfileinfo
' Get file attributes
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
' If it is a form item
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
' If you get to the end of the file, quit.
Loop Until (iformstart+2) >= iformend
Requestbindate = ""
Set TStream = Nothing
Isgetdata_=true
End If
End Sub

' Save to file, automatically overwrite existing file with the same name
Public Function SaveToFile (Item,path)
Savetofile=savetofileex (Item,path,true)
End Function

' Save to file, set file name automatically
Public Function AutoSave (Item,path)
Autosave=savetofileex (Item,path,false)
End Function

' Save to file, over to true, automatically overwrite existing files with the same name, otherwise automatically rename the file to save
Private Function Savetofileex (item,path,over)
On Error Resume Next
Dim Ofilestream
Dim Tmppath
Dim nohack ' anti-black buffer
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, ".") ' Important changes to prevent hackers binary "01" Broken name!!!
Tmppath=nohack (0) & "." &nohack (UBound (nohack)) ' Important changes to prevent hacker binary ' 01 ' name!!!
If Over then
If Isallowext (Getfileext (tmppath)) Then
Ofilestream.savetofile tmppath,2
Else
Iserr_=3
errmessage_= "This suffix file is not allowed to be uploaded!"
End if
Else
Path=getfilepath (Path)
If Isallowext (File (Item). Fileext) Then
Do
Err.Clear ()
Nohack=split (Path&getnewfilename () & "." &file (Item). Fileext, ".") ' Important changes to prevent hackers binary "01" Broken name!!!
Tmppath=nohack (0) & "." &nohack (UBound (nohack)) ' Important changes to prevent hackers binary "01" Broken Name!!!
Ofilestream.savetofile Tmppath
Loop Until err.number<1
Ofilestream.savetofile Path
Else
Iserr_=3
errmessage_= "This suffix file is not allowed to be uploaded!"
End if
End if
Ofilestream.close
Set Ofilestream = Nothing
If Iserr_=3 then savetofileex= "" Else Savetofileex=getfilename (Tmppath)
End Function

' Get File data
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_= "This suffix file is not allowed to be uploaded!"
Filedata= ""
End if
End Function

' Get file path
Public Function GetFilePath (FullPath)
If FullPath <> "Then
GetFilePath = Left (Fullpath,instrrev (FullPath, "\"))
Else
GetFilePath = ""
End If
End function

' Get file name
Public Function GetFileName (FullPath)
If FullPath <> "Then
GetFileName = Mid (Fullpath,instrrev (FullPath, "\") +1)
Else
GetFileName = ""
End If
End function

' Get the file suffix name
Public Function Getfileext (FullPath)
If FullPath <> "Then
Getfileext = LCase (Mid (Fullpath,instrrev (FullPath, ".") +1))
Else
Getfileext = ""
End If
End function

' Get a non-repeating ordinal number
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" &amp ; 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

' File attribute Class
Class Clsfileinfo
Dim Formname,filename,filepath,filesize,filemime,filestart,fileext
End Class
%>

<%
Dim Upfile,formpath,serverpath,fspath,formname,filename,ofile,upfilecount
Upfilecount=0
Set upfile=new clsup ' upload object
Upfile. noallowext= "ASP;EXE;HTM;HTML;ASPX;CS;VB;JS;" ' Set the blacklist for upload type
Upfile. GetData (204800) ' Get upload data, limit maximum upload 200k,102400 bytes =100k
%>
<title> File Upload </title>
<style type= "Text/css" >
<!--
. p9{font-size:9pt; font-family: Song Body}
-
</style>
<meta http-equiv= "Content-type" content= "text/html; charset=gb2312 ">
<body leftmargin= "topmargin=" class= "P9" >
<%
If Upfile.iserr then ' if an error occurs
Select Case Upfile.iserr
Case 1
Response.Write "You didn't upload the data??? Are you mistaken??
Case 2
Response.Write "The file you uploaded exceeds the server limit, Max 200K"
End Select
Else
%>
<table border= "1" cellpadding= "0" cellspacing= "0" bordercolor= "#000000" class= "P9" style= "Border-collapse: Collapse ">
<tr bgcolor= "#CCCCCC" >
&LT;TD height= "valign= ' middle ' > Local files </td>
&LT;TD valign= ' middle ' > Size (bytes) </td>
&LT;TD valign= ' middle ' > Upload to </td>
&LT;TD valign= ' middle ' > Status </td>
&LT;TD valign= ' Middle ' >11111111</td>
</tr>
<%
Fspath=getfilepath (Server.MapPath ("upfile.asp"), "\") ' Gets the current file in the server path
Serverpath=getfilepath (Request.ServerVariables ("Http_referer"), "/") ' Get the location on the website
For every formName in Upfile.file ' lists all uploaded files
Set Ofile=upfile.file (FormName)
Filename=upfile.form (FormName) ' Gets the value of the text field
If not filename> "and then Filename=ofile.filename ' if no new file name is entered, use the original file name
' Upfile. SaveToFile formname,fspath&filename ' Save file can also be saved using AutoSave, but will automatically create a new file name
Upfile. AutoSave formname,fspath&filename ' Save file can also be saved using AutoSave, but will automatically create a new file name
%>
<tr>
&LT;TD height= "valign= ' middle ' > <%=oFile.FilePath&oFile.FileName%> </td>
&LT;TD valign= ' middle ' > <%=oFile.filesize%> </td>
&LT;TD valign= ' middle ' > <a href= "<%=serverpath&FileName%>" ><%=FileName%></A> </ Td>
&LT;TD valign= ' middle ' > <%
If Upfile.iserr Then
Response.Write Upfile.errmessage
Else
Upfilecount=upfilecount+1
Response.Write "Upload succeeded"
End If
%> </td>
&LT;TD align= "center" valign= ' Middle ' ><%=FileName%></td>
</tr><%
Set ofile=nothing
Next
%>
<%
End If
Set Upfile=nothing ' Delete this object
%>
</table>
</p>[<a href= "1.asp" > Return </a>]
</body>

<%
function GetFilePath (FULLPATH,STR)
If FullPath <> "Then
GetFilePath = Left (Fullpath,instrrev (FullPath, str))
Else
GetFilePath = ""
End If
End function

Function Checkdir (FolderPath)
Dim fso
Folderpath=server.mappath (FolderPath)
Set FSO = Server.CreateObject ("Scripting.FileSystemObject")
If FSO. FolderExists (FolderPath) Then
' Existence
Checkdir = True
Else
' does not exist
Checkdir = False
End if
Set FSO = Nothing
End Function
%>

No fear Upload class modified version ASP