ASP file Upload: File Upload source code

Source: Internet
Author: User
Tags chr file upload save file

<!--#include file= "Upload.inc"-->
<%
Dim upload,file,formname,formpath,icount,filename,fileext
Set upload=new upload_5xsoft ' Build upload Object
Formpath= "Uploadimages/"
"Add (/) to the directory
If Right (formpath,1) <> "/" Then formpath=formpath& "/"
Icount=0
For every formName in Upload.file ' lists all uploaded files
Set File=upload.file (formName) ' generates a File object
If File.filesize<100 Then
Response.Write "<font size=3><br> please first select the pictures you want to upload [<a href=# onclick=history.go ( -1) > re-upload </a>] </font> "
Response.End
End If

If file.filesize>1000000 Then
Response.Write "<font size=3><br> picture size exceeded limit [<a href=# onclick=history.go ( -1) > re-upload </a>]</ Font> "
Response.End
End If

Fileext=lcase (Right (file.filename,4))

If fileext<> ". jpg" and fileext<> ". gif" Then
Response.Write "<font size=3><br> file format can only be JPG and GIF format [<a href=# onclick=history.go ( -1) > re-upload </a >]</font> "
Response.End
End If
Randomize
Rannum=int (90000*RND) +10000
Filename=formpath&year (now) &month-&day (now) &hour (now) &minute (now) &second (now) & Fileext
Filename1=year (now) &month (now), &day (now), &hour (now) &minute (now) &second

If file. Filesize>0 Then ' if FileSize > 0 indicates file data
File. SaveAs server.mappath (filename) ' Save file '
Response.Write "<script>parent.form1.img.value= '" &FileName1& "' </script>"

Icount=icount+1
End If
Set file=nothing
Next
Set Upload=nothing ' Deletes this object

Response.Write " '
Response.End
%>

Here is the code for UPLOAD.INC.

<script Runat=server language=vbscript>
Dim Upfile_5xsoft_stream
Class Upload_5xsoft
Dim form,file,version
Private Sub Class_Initialize
Dim istart,ifilenamestart,ifilenameend,iend,vbenter,iformstart,iformend,thefile
Dim strdiv,mformname,mformvalue,mfilename,mfilesize,mfilepath,idivlen,mstr
If Request.totalbytes<1 then Exit Sub
Set Form=createobject ("Scripting.Dictionary")
Set File=createobject ("Scripting.Dictionary")
Set Upfile_5xsoft_stream=createobject ("ADODB.stream")
Upfile_5xsoft_stream.mode=3
Upfile_5xsoft_stream.type=1
Upfile_5xsoft_stream.open
Upfile_5xsoft_stream.write Request.BinaryRead (request.totalbytes)
VBENTER=CHR (&AMP;CHR) (10)
Idivlen=instring (1,vbenter) +1
Strdiv=substring (1,idivlen)
Iformstart=idivlen
Iformend=instring (Iformstart,strdiv)-1
While Iformstart < Iformend
Istart=instring (Iformstart, "name=" "")
Iend=instring (Istart+6, "" "")
Mformname=substring (istart+6,iend-istart-6)
Ifilenamestart=instring (iend+1, "filename=" "")
If Ifilenamestart>0 and Ifilenamestart<iformend then
Ifilenameend=instring (ifilenamestart+10, "" "")
Mfilename=substring (IFILENAMESTART+10,IFILENAMEEND-IFILENAMESTART-10)
Istart=instring (Ifilenameend+1,vbenter&vbenter)
Iend=instring (Istart+4,vbenter&strdiv)
If Iend>istart Then
Mfilesize=iend-istart-4
Else
Mfilesize=0
End If
Set Thefile=new FileInfo
Thefile.filename=getfilename (Mfilename)
Thefile.filepath=getfilepath (Mfilename)
Thefile.filesize=mfilesize
Thefile.filestart=istart+4
Thefile.formname=formname
File.add Mformname,thefile
Else
Istart=instring (Iend+1,vbenter&vbenter)
Iend=instring (Istart+4,vbenter&strdiv)

If Iend>istart Then
Mformvalue=substring (istart+4,iend-istart-4)
Else
Mformvalue= ""
End If
Form. ADD Mformname,mformvalue
End If

Iformstart=iformend+idivlen
Iformend=instring (Iformstart,strdiv)-1
Wend
End Sub

Private Function subString (Thestart,thelen)
Dim i,c,stemp
Upfile_5xsoft_stream.position=thestart-1
Stemp= ""
For I=1 to TheLen
If Upfile_5xsoft_stream.eos then Exit for
C=ASCB (Upfile_5xsoft_stream.read (1))
If C > 127 Then
If Upfile_5xsoft_stream.eos then Exit for
STEMP=STEMP&CHR (AscW (ChrB (AscB (Upfile_5xsoft_stream.read (1)) &CHRB (c)))
I=i+1
Else
STEMP=STEMP&CHR (c)
End If
Next
Substring=stemp
End Function

Private Function instring (THESTART,VARSTR)
Dim i,j,bt,thelen,str
Instring=0
Str=tobyte (VARSTR)
Thelen=lenb (STR)
For I=thestart to Upfile_5xsoft_stream.size-thelen
If I>upfile_5xsoft_stream.size then Exit Function
Upfile_5xsoft_stream.position=i-1
If AscB (Upfile_5xsoft_stream.read (1)) =ASCB (MidB (str,1)) Then
Instring=i
For j=2 to TheLen
If Upfile_5xsoft_stream.eos Then
Instring=0
Exit for
End If
If AscB (Upfile_5xsoft_stream.read (1)) &LT;&GT;ASCB (MidB (str,j,1)) Then
Instring=0
Exit for
End If
Next
If Instring<>0 then Exit Function
End If
Next
End Function

Private Sub class_terminate 
  form. RemoveAll
  file. RemoveAll
  Set form=nothing
  set file=nothing
  Upfile_5xsoft_stream.close
  set up File_5xsoft_stream=nothing
End Sub
  
 
 private function GetFilePath (fullpath)
  If fullpath <> "Then
   GetFilePath = Left (Fullpath,instrrev (FullPath," "))
  E LSE
   GetFilePath = "
  end If
 End  function
 
 private function GetFileName (fullpath)
  If fullpath <> "" Then
   GetFileName = Mid (Fullpath,instrrev (FULLP Ath, "") +1
  Else
   getfilename = "
  end If
 End  function

Private function ToByte (STR)
Dim I,icode,c,ilow,ihigh
Tobyte= ""
For I=1 to Len (STR)
C=mid (str,i,1)
Icode =ASC (c)
If icode<0 Then icode = Icode + 65535
If icode>255 Then
Ilow = Left (Hex (ASC (c)), 2)
Ihigh =right (Hex (ASC (c)), 2)
ToByte = ToByte & ChrB ("&h" &ilow) & ChrB ("&h" &ihigh)
Else
ToByte = ToByte & ChrB (AscB (c))
End If
Next
End Function
End Class


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

Public Function SaveAs (fullpath)
Dim dr,errorchar,i
Saveas=1
If trim (fullpath) = "" or filesize=0 or filestart=0 or filename= "" Then Exit function
If Filestart=0 or right (fullpath,1) = "/" Then Exit function
Set Dr=createobject ("ADODB.stream")
Dr. Mode=3
Dr. Type=1
Dr. Open
Upfile_5xsoft_stream.position=filestart-1
Upfile_5xsoft_stream.copyto dr,filesize
Dr. SaveToFile fullpath,2
Dr. Close
Set dr=nothing
Saveas=0
End Function
End Class
</SCRIPT>

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.