帮助中心
|

虚拟主机Asp无组件文件上传到租用服务器空间的实例

方法/步骤

  • 1.库文件(upload.inc.asp)
    <%
    Dim oUpFileStream

    Class UpFile_Class

    Dim Form,File,Version,Err

    Private Sub Class_Initialize
    Version = "无组件上传类 Version V1.0"
    Err = -1
    End Sub

    Private Sub Class_Terminate
    '清除变量及对像
    If Err < 0 Then
    Form.RemoveAll
    Set Form = Nothing
    File.RemoveAll
    Set File = Nothing
    oUpFileStream.Close
    Set oUpFileStream = Nothing
    End If
    End Sub

    Public Sub GetData (RetSize)
    '定义变量
    Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
    Dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
    Dim iFindStart,iFindEnd
    Dim iFormStart,iFormEnd,sFormName
    '代码开始
    If Request.TotalBytes < 1 Then
    Err = 1
    Exit Sub
    End If
    If RetSize > 0 Then
    If Request.TotalBytes > RetSize Then
    Err = 2
    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 (13) & ChrB (10)
    '取得每个项目之间的分隔符
    sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
    iStart = LenB (sSpace)
    iFormStart = iStart+2
    '分解项目
    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
    '取得表单项目名称
    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 InStr (45,sInfo,"filename=""",1) > 0 Then
    Set oFileInfo = new FileInfo_Class
    '取得文件属性
    iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
    iFindEnd = InStr (iFindStart,sInfo,"""",1)
    sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
    oFileInfo.FileName = Mid (sFileName,InStrRev (sFileName, "")+1)
    oFileInfo.FilePath = Left (sFileName,InStrRev (sFileName, "")+1)
    oFileInfo.FileExt = Mid (sFileName,InStrRev (sFileName, ".")+1)
    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
    file.add sFormName,oFileInfo
    else
    '如果是表单项目
    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
    '如果到文件尾了就退出
    Loop Until (iFormStart+2) = iFormEnd
    RequestBinDate = ""
    Set tStream = Nothing
    End Sub
    End Class

    '文件属性类
    Class FileInfo_Class
    Dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt
    '保存文件方法
    Public Function SaveToFile (Path)
    On Error Resume Next
    Dim oFileStream
    Set oFileStream = CreateObject ("ADODB.Stream")
    oFileStream.Type = 1
    oFileStream.Mode = 3
    oFileStream.Open
    oUpFileStream.Position = FileStart
    oUpFileStream.CopyTo oFileStream,FileSize
    oFileStream.SaveToFile Path,2
    oFileStream.Close
    Set oFileStream = Nothing
    if Err.Number<>0 then
    SaveToFile=err.number&"**"&Err.descripton
    else
    SaveToFile="ok"
    end if
    End Function

    '取得文件数据
    Public Function FileDate
    oUpFileStream.Position = FileStart
    FileDate = oUpFileStream.Read (FileSize)
    End Function
    End Class
    %>


    2.处理用户提交后的页面(upload.asp)
    <!--#include file="upload.inc.asp"-->
    <html>
    <head>
    <title>文件上传</title>
    </head>
    <body topmargin="0" leftmargin="0">
    <table width=100% border=0 cellspacing="0" cellpadding="0"><tr><td class=tablebody1 width=100% height=100% >
    <%
    dim upload,file,formName,formPath,filename,fileExt
    dim ranNum
    call UpFile()
    '===========无组件上传(upload_0)====================
    sub UpFile()
    set upload=new UpFile_Class '建立上传对象
    upload.GetData (500*1024) '取得上传数据,此处即为500 K

    if upload.err > 0 then
    select case upload.err
    case 1
    Response.Write "请先选择你要上传的文件 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
    case 2
    Response.Write "图片大小超过了限制 500 K [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
    end select
    exit sub
    else
    formPath=upload.form("filepath") '文件保存目录,此目录必须为程序可读写
    if formPath="" then
    formPath="rwdata/"
    end if
    '在目录后加(/)
    if right(formPath,1)<>"/" then
    formPath=formPath&"/"
    end if

    for each formName in upload.file '列出所有上传了的文件
    set file=upload.file(formName) '生成一个文件对象
    if file.filesize<100 then
    response.write "请先选择你要上传的图片 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
    response.end
    end if

    fileExt=lcase(file.FileExt)
    if CheckFileExt(fileEXT)=false then
    response.write "文件格式不正确 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
    response.end
    end if

    'randomize
    ranNum=int(90000*rnd)+10000
    filename=formPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&fileExt
    if file.FileSize>0 then '如果 FileSize > 0 说明有文件数据
    result=file.SaveToFile(Server.mappath(filename)) '保存文件
    if result="ok" then
    response.write formName&" upload OK, had saved to "&filename&"<br>"
    else
    response.write formName&" upload Fail,"&result&"<br>"
    end if
    end if
    set file=nothing
    next
    set upload=nothing
    end if
    end sub

    '判断文件类型是否合格
    Private Function CheckFileExt (fileEXT)
    dim Forumupload
    Forumupload="gif,jpg,bmp,jpeg"
    Forumupload=split(Forumupload,",")
    for i=0 to ubound(Forumupload)
    if lcase(fileEXT)=lcase(trim(Forumupload(i))) then
    CheckFileExt=true
    exit Function
    else
    CheckFileExt=false
    end if
    next
    End Function
    %>
    </td></tr></table>
    </body>
    </html>



    3.HTML 表单(upload.html)
    <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
    <html>
    <head>
    <meta http-equiv="Content-Type" content="text/html; charset=gb2312">
    <title>asp 无组件上传</title>
    </head>

    <body>
    请选择要上传的文件
    <form action="upfile.asp" method="post" enctype="multipart/form-data" name="form1">
    <input type="file" name="file">
    <!--<br>
    <input type="file" name="file">
    <br>
    <input type="file" name="file">
    <br>-->
    <input type="submit" name="Submit" value="提交">
    </form>
    </body>
    </html>