ASP no component File upload code

Source: Internet
Author: User
Tags base64 file upload lowercase save file

<%Server.ScriptTimeOut=5000%>
<!--#include file= "Upload_wj.inc"-->
<%
Dim upload, File, MaxWidth, maxheight, Ofilestream, Bytes, ratio1, Ratio2

Set upload = new Upload_file
Set file = Upload.file ("pic")

MaxWidth = CInt (upload. Form ("width")
MaxHeight = CInt (upload. Form ("height")

If file. FileSize > 0 Then

oupfilestream.position = file. Filestart
Set Ofilestream = CreateObject ("ADODB.stream")
With Ofilestream
. Type=1
. Mode=3
. Open
Oupfilestream.copyto ofilestream, file. FileSize
. Position = 0
. Type = 1
bytes =. Read ()
. Close
End With

With Server.CreateObject ("Persits.jpeg")
. Openbinary bytes
. Preserveaspectratio = True
Ratio1 = maxwidth/. OriginalWidth
Ratio2 = maxheight/. OriginalHeight
If Ratio1 < 1 Or Ratio2 < 1 Then
If ratio1 > Ratio2 Then ratio1 = Ratio2
. Width =. OriginalWidth * Ratio1
bytes =. Binary
End If
End With

With CreateObject ("Microsoft.XMLDOM"). createelement ("TXT")
. DataType = "Bin.base64"
. nodeTypedValue = bytes
Response. Write "Data:image/jpeg;base64," & Text
End With

End If

Set file = Nothing
Set upload = Nothing
%>

<%
'----------------------------------------------------------------------
' Please keep this declaration information when forwarding, this statement does not affect your speed!
' ******************* no component upload class ********************************
"Modified by: Liang Fearless
' E-mail: yjlrb@21cn.com
' Website: http://www.25cn.com
' Original author: Dao Xiang Old farmer
' Original author website: http://www.5xsoft.com
' Disclaimer: This upload class was modified on the basis of transformation-free upload classes published by the programming community.
' It's nearly 50 times times faster than uploading classes without components in the transformation programming world, when uploading files of 4M size
The server only needs 10 seconds to process, is currently the fastest component-free upload program, the current version of 0.96
' Source code open, free to use, for business purposes, please contact the author
' File attributes: For example, uploading files for C:myfiledoc.txt
' filename filename string ' doc.txt '
' FileSize File size value 1210
' FileType file type string ' Text/plain '
' Fileext file name extension string ' txt '
' FilePath file original path string ' C:myfile '
' Note When using:
' Because Scripting.Dictionary is case-sensitive, the project names on the page and ASP pages are the same size
' Write, if people are accustomed to using uppercase or lowercase, in order to prevent mistakes, you can put
' Sformname = Mid (Sinfo,ifindstart,ifindend-ifindstart)
' instead
' (lowercase) sformname = LCase (Mid (Sinfo,ifindstart,ifindend-ifindstart))
' (uppercase person) Sformname = UCase (Mid (Sinfo,ifindstart,ifindend-ifindstart))
'**********************************************************************
'----------------------------------------------------------------------
Dim Oupfilestream

Class Upload_file

Dim form,file,version,i

Private Sub Class_Initialize
' Define variables
Dim requestbindate,sstart,bcrlf,sinfo,iinfostart,iinfoend,tstream,istart,ofileinfo
Dim ifilesize,sfilepath,sfiletype,sformvalue,sfilename
Dim ifindstart,ifindend
Dim iformstart,iformend,sformname
' Code starts
version= "No component upload class Version 0.96"
Set Form = Server.CreateObject ("Scripting.Dictionary")
Set File = Server.CreateObject ("Scripting.Dictionary")
If Request.TotalBytes < 1 then Exit Sub
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 separator between each item
Sstart = MidB (requestbindate,1, InStrB (1,REQUESTBINDATE,BCRLF)-1)
IStart = LenB (Sstart)
Iformstart = istart+2
' Explode project
Todo
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,sstart)-1
Ifindstart = InStr (22,sinfo, "name=" "", 1) +6
Ifindend = InStr (Ifindstart,sinfo, "" "", 1)
Sformname = Mid (Sinfo,ifindstart,ifindend-ifindstart)
' If it's a file
If InStr (45,sinfo, "filename=" "", 1) > 0 Then
Set ofileinfo= new FileInfo
' Get file properties
Ifindstart = InStr (Ifindend,sinfo, "filename=" "", 1) +10
Ifindend = InStr (Ifindstart,sinfo, "" "", 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.filetype = Mid (Sinfo,ifindstart,ifindend-ifindstart)
Ofileinfo.filestart = Iinfoend
Ofileinfo.filesize = Iformstart-iinfoend-2
Ofileinfo.formname = Sformname
' This part is the modified part
i = 1
Do While file. Exists (Sformname)
Sformname = Sformname & I
i = i + 1
Loop
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. Item (sformname) = form. Item (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
End Sub

Private Sub class_terminate 
  ' Clear variables and to
  if not request.totalbytes<1 then
     Oupfilestream.close
    set oupfilestream =nothing
    End If
  Form.removeall
  File.removeall
  set form=nothing
  set file=nothing
End Sub
&NBSP;&N Bsp
  Get file path
Private function GetFilePath (fullpath)
  If fullpath <> "Then
  &nb Sp GetFilePath = Left (Fullpath,instrrev (FullPath, ""))
    Else
    getfilepath = ""
  End If
End Function
 
' get filename
Private function GetFileName (fullpath)
  If Fullpat H <> "" Then
    GetFileName = Mid (Fullpath,instrrev (FullPath, "") +1)
    Else
    getfilename = "
  end If
End Function

' Get extension
Private function Getfileext (fullpath)
If fullpath <> "" Then
Getfileext = Mid (Fullpath,instrrev (FullPath, ".") +1)
Else
Getfileext = ""
End If
End Function

End Class

' File attribute Class
Class FileInfo
Dim formname,filename,filepath,filesize,filetype,filestart,fileext
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
filestart= 0
FormName = ""
FileType = ""
Fileext = ""
End Sub

' Save File Method
Public Function SaveToFile (fullpath)
Dim ofilestream,errorchar,i
Savetofile=1
If trim (fullpath) = "" or right (fullpath,1) = "/" Then Exit function
Set Ofilestream=createobject ("ADODB.stream")
Ofilestream.type=1
Ofilestream.mode=3
Ofilestream.open
Oupfilestream.position=filestart
Oupfilestream.copyto ofilestream,filesize
Ofilestream.savetofile fullpath,2
Ofilestream.close
Set ofilestream=nothing
Savetofile=0
End Function
End Class
%>

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.