<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%>