ASP upload files using File Upload component

Source: Internet
Author: User
Tags file upload rar save file trim zip


<style>body,form,fieldset,input,textarea{margin:0;padding:0;} Body{background: #f2f2f2; height:100%;font:12px tahoma,arial;color: #333; text-align:center;} </style>
<body>
<form name= "form" method= "Post action=" upload.asp tutorial? Act=upfile "enctype=" Multipart/form-data ">
<input type= "File" Name= "File11" size= ">"
<input type= "Submit" name= "submit" value= "Upload" class= "button" >
</form>
</body>


<%if act= "upfile" Then ' upload related%>
<style>body,form,fieldset,input,textarea{margin:0;padding:0;} Body{background: #f2f2f2; height:100%;font:12px tahoma,arial;color: #333; text-align:center;} </style>
<body>
<script Runat=server language=vbscript>
Dim Data_5xsoft
Class Upload_5xsoft

Dim objform,objfile,version
Public function form (strform)
Strform=lcase (Strform)
If not objform.exists (strform) then form= "" Else Form=objform (strform)
End Function

Public function file (strfile)
Strfile=lcase (strfile)
If not objfile.exists (strfile) Then set file=new FileInfo else set File=objfile (strfile)
End Function

Private Sub Class_Initialize
Dim requestdata,sstart,vbcrlf,sinfo,iinfostart,iinfoend,tstream,istart,thefile
Dim ifilesize,sfilepath,sfiletype,sformvalue,sfilename
Dim ifindstart,ifindend
Dim iformstart,iformend,sformname
version= "Transformation HTTP Upload Program version 2.0"
Set Objform=server.createobject ("Scripting.Dictionary")
Set Objfile=server.createobject ("Scripting.Dictionary")
If Request.totalbytes<1 then Exit Sub
Set tstream = Server.CreateObject ("ADODB.stream")
Set data_5xsoft = Server.CreateObject ("ADODB.stream")
Data_5xsoft.type = 1
Data_5xsoft.mode =3
Data_5xsoft.open
Data_5xsoft.write Request.BinaryRead (request.totalbytes)
Data_5xsoft.position=0
RequestData =data_5xsoft.read
Iformstart = 1
Iformend = LenB (requestdata)
vbCrLf = ChrB (+) & ChrB (10)
Sstart = MidB (requestdata,1, INSTRB (IFORMSTART,REQUESTDATA,VBCRLF)-1)
Istart = LenB (Sstart)
Iformstart=iformstart+istart+1
while (Iformstart +) < Iformend
Iinfoend = InStrB (Iformstart,requestdata,vbcrlf & vbCrLf) +3
Tstream.type = 1
Tstream.mode =3
Tstream.open
Data_5xsoft.position = Iformstart
Data_5xsoft.copyto Tstream,iinfoend-iformstart
tstream.position = 0
Tstream.type = 2
Tstream.charset = "gb2312"
Sinfo = Tstream.readtext
Tstream.close
' Get form Item name
Iformstart = INSTRB (Iinfoend,requestdata,sstart)
Ifindstart = InStr (22,sinfo, "name=" "", 1) +6
Ifindend = InStr (Ifindstart,sinfo, "" "", 1)
Sformname = LCase (Mid (Sinfo,ifindstart,ifindend-ifindstart))
' If it's a file
If InStr (45,sinfo, "filename=" "", 1) > 0 Then
Set Thefile=new FileInfo
' Get filename
Ifindstart = InStr (Ifindend,sinfo, "filename=" "", 1) +10
Ifindend = InStr (Ifindstart,sinfo, "" "", 1)
sFileName = Mid (Sinfo,ifindstart,ifindend-ifindstart)
Thefile.filename=getfilename (sFileName)
Thefile.filepath=getfilepath (sFileName)
' Get file type
Ifindstart = InStr (Ifindend,sinfo, "Content-type:", 1) +14
Ifindend = InStr (IFINDSTART,SINFO,VBCR)
Thefile.filetype =mid (Sinfo,ifindstart,ifindend-ifindstart)
Thefile.filestart =iinfoend
Thefile.filesize = iformstart-iinfoend-3
Thefile.formname=sformname
If not objfile.exists (sformname) then Objfile.add sformname,thefile
Else
' If it is a form item
Tstream.type =1
Tstream.mode =3
Tstream.open
Data_5xsoft.position = Iinfoend
Data_5xsoft.copyto tstream,iformstart-iinfoend-3
tstream.position = 0
Tstream.type = 2
Tstream.charset = "gb2312"
Sformvalue = Tstream.readtext
Tstream.close
If Objform.exists (sformname) Then
Objform (Sformname) =objform (sformname) & "," &sformvalue
Else
Objform.add Sformname,sformvalue
End If
End If
Iformstart=iformstart+istart+1
Wend
Requestdata= ""
Set Tstream =nothing
End Sub
Private Sub Class_Terminate
If Request.totalbytes>0 Then
Objform.removeall
Objfile.removeall
Set objform=nothing
Set objfile=nothing
Data_5xsoft.close
Set Data_5xsoft =nothing
End If
End Sub

Private Function GetFilePath (FullPath)
If FullPath <> "" Then GetFilePath = Left (Fullpath,instrrev (FullPath, "")) Else GetFilePath = ""
End Function

Private Function GetFileName (FullPath)
If FullPath <> "" Then GetFileName = Mid (Fullpath,instrrev (FullPath, "") +1) Else GetFileName = ""
End Function

End Class

Class FileInfo
Dim Formname,filename,filepath,filesize,filetype,filestart
Private Sub Class_Initialize
filename = ""
filepath = ""
FileSize = 0
filestart= 0
FormName = ""
filetype = ""
End Sub

Public Function SaveAs (FullPath)
Dim dr,errorchar,i
Saveas=true
If trim (fullpath) = "" or filestart=0 or filename= "" or right (fullpath,1) = "/" Then Exit function
Set Dr=createobject ("ADODB.stream")
Dr.mode=3
Dr.type=1
Dr.open
Data_5xsoft.position=filestart
Data_5xsoft.copyto dr,filesize
Dr.savetofile fullpath,2
Dr.close
Set dr=nothing
Saveas=false
End Function
End Class
</script>
<%
Dim upload,file,formpath,icount,filename,fileext
Dim formname,uploadsuc,forum_upload,forumupload,upf,f_type,f_name,f_ftn,rannum
Set upload=new upload_5xsoft ' Build upload Object
' ******************************** list all uploaded files ***************************************************
For each formname in Upload.objfile
Set File=upload.file (FormName)
If File.filesize>0 Then
' ******************************** detection file type ****************************************************
Fileext=ucase (Right (file.filename,4))
Uploadsuc=false
Forum_upload= "Rar|zip|swf|jpg|png|gif|doc|txt|chm|pdf|ace|mp3|wma|wmv|midi|avi|rm|ra|rmvb|mov|xls"
Forumupload=split (forum_upload, "|")
For i=0 to UBound (forumupload)
If fileext= "." &trim (Forumupload (i)) then
Uploadsuc=true
Exit For
Else
Uploadsuc=false
End If
Next
If Uploadsuc=false Then
Response.Write "file format is incorrect [<a href=" "Post.asp?act=upload" "> Continue uploading </a>]"
Response.End
End If
' ******************************** build directory folder for file uploads ****************************************
Set Upf=server.createobject ("Scripting.FileSystemObject")
If Err<>0 Then
Err.Clear
Response.Write ("Your server does not support FSO")
Response.End
End If
F_type= replace (Fileext, ".", "")
F_name= year, & "-" &month (now)
If Upf.folderexists (Server.MapPath ("upload/" &f_name)) =false Then
Upf.createfolder Server.MapPath ("upload/" &f_name)
End If
F_ftn= "upload/" &f_name
Set upf=nothing
' ******************************** save uploaded files to folder *****************************************
Randomize
Rannum=int (90000*RND) +10000
filename=f_ftn& "/" &day (now) & "-" &rannum& "-" &file.filename
File.saveas server.mappath (filename) ' Save file '
If f_type= "JPG" or f_type= "gif" or f_type= "PNG" then
Response.Write "<script>parent.form1.content.value+= ' [img]" &filename& "[/img] ' </script>"
ElseIf f_type= "Zip" or f_type= "rar" or f_type= "Doc" or f_type= "TXT" then
Response.Write "<script>parent.form1.content.value+= ' [url]" &filename& "[/url] ' </script>"
Else
Response.Write "<script>parent.form1.content.value+= '" &filename& "' </script>"
End If
Icount=icount+1
Set file=nothing
End If
Next
Set Upload=nothing ' Deletes this object
Response.Write ("File Upload success!") <a href= "Upload.asp?act=upload" "> Continue upload </a>")
%>
</body>
<%end if%>

<%call closeall%>

Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.