zoukankan      html  css  js  c++  java
  • ASP无组件上载,带进度条,多文件上载。。

    各种ASP无组件上载,带进度条的实在太多,用起来也不方便,今天自己写了一个,希望大家给点意见

    页面都是UTF-8 编码的,用的时候可根据自己页面编码转换

    核心编码:SundyUpload.asp
    例子:Example.asp

    SundyUpload.asp代码如下:

    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
    <%
    Dim SundyUpload_SourceData
    Class SundyUpload
      
    Dim objForm,objFile,Version,objProgress
        
    Dim xmlPath,CharsetEncoding
      
    Public Function Form(strForm)
        strForm
    =lcase(strForm)
        
    If NOT objForm.exists(strForm) Then
          Form
    =""
        
    Else
          Form
    =objForm(strForm)
        
    End If
      
    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 If
      
    End Function
      
        
    Public Sub UploadInit(progressXmlPath,charset)
        
    Dim RequestData,sStart,Crlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
            
    Dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
            
    Dim iFindStart,iFindEnd
            
    Dim iFormStart,iFormEnd,sFormName
          
            Version
    ="Upload Width Progress Bar Version 1.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 SundyUpload_SourceData = Server.CreateObject("adodb.stream")
            SundyUpload_SourceData.Type 
    = 1
            SundyUpload_SourceData.Mode 
    =3
            SundyUpload_SourceData.Open
            
            
    Dim TotalBytes
            
    Dim ChunkReadSize
            
    Dim DataPart, PartSize
            
    Dim objProgress
            
            TotalBytes 
    = Request.TotalBytes     ' 总大小
            ChunkReadSize = 64 * 1024    ' 分块大小64K
            BytesRead = 0
            xmlPath 
    = progressXmlPath
            CharsetEncoding 
    = charset
            
    If CharsetEncoding = "" Then
              CharsetEncoding 
    = "utf-8"
            
    End If
            
    Set objProgress = New Progress
            objProgress.ProgressInit(xmlPath)
            objProgress.UpdateProgress Totalbytes,
    0
            
    '循环分块读取
            Do While BytesRead < TotalBytes
                
    '分块读取
                PartSize = ChunkReadSize
                
    If PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead
                DataPart 
    = Request.BinaryRead(PartSize)
                BytesRead 
    = BytesRead + PartSize
        
                SundyUpload_SourceData.Write DataPart
                
                objProgress.UpdateProgress Totalbytes,BytesRead 
            
    Loop
            
    'SundyUpload_SourceData.Write  Request.BinaryRead(Request.TotalBytes)
            SundyUpload_SourceData.Position=0
            RequestData 
    =SundyUpload_SourceData.Read 
        
            iFormStart 
    = 1
            iFormEnd 
    = LenB(RequestData)
            Crlf 
    = chrB(13& chrB(10)
            sStart 
    = MidB(RequestData,1, InStrB(iFormStart,RequestData,Crlf)-1)
            iStart 
    = LenB (sStart)
            iFormStart
    =iFormStart+iStart+1
            
    While (iFormStart + 10< iFormEnd 
                iInfoEnd 
    = InStrB(iFormStart,RequestData,Crlf & Crlf)+3
                tStream.Type 
    = 1
                tStream.Mode 
    =3
                tStream.Open
                SundyUpload_SourceData.Position 
    = iFormStart
                SundyUpload_SourceData.CopyTo tStream,iInfoEnd
    -iFormStart
                tStream.Position 
    = 0
                tStream.Type 
    = 2
                tStream.Charset 
    =CharsetEncoding
                sInfo 
    = tStream.ReadText
                tStream.Close
                
    '取得表单项目名称
                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 InStr (45,sInfo,"filename=""",1> 0 Then
                    
    Set theFile=new FileInfo
                    
    '取得文件名
                    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)
                    
    '取得文件类型
                    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
                    
    End If
                
    Else
                    
    '如果是表单项目
                    tStream.Type =1
                    tStream.Mode 
    =3
                    tStream.Open
                    SundyUpload_SourceData.Position 
    = iInfoEnd 
                    SundyUpload_SourceData.CopyTo tStream,iFormStart
    -iInfoEnd-3
                    tStream.Position 
    = 0
                    tStream.Type 
    = 2
                    tStream.Charset 
    = CharsetEncoding
                    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_Initialize 
            
        
    End Sub
        
        
    Private Sub Class_Terminate  
          
    If Request.TotalBytes>0 Then
                objForm.RemoveAll
                objFile.RemoveAll
                
    Set objForm=Nothing
                
    Set objFile=Nothing
                SundyUpload_SourceData.Close
                
    Set SundyUpload_SourceData = Nothing
          
    End If
            
    Set objProgress = Nothing
            
    Set objFso = Server.CreateObject("Scripting.FileSystemObject")
            
    If objFso.FileExists(xmlPath) Then
              objFso.DeleteFile(xmlPath)
            
    End If
            
    Set objFso = Nothing
        
    End Sub
     
        
    Private Function GetFilePath(FullPath)
            
    If FullPath <> "" Then
              GetFilePath 
    = left(FullPath,InStrRev(FullPath, ""))
            
    Else
              GetFilePath 
    = ""
            
    End If
        
    End Function
     
        
    Private Function GetFileName(FullPath)
            
    If FullPath <> "" Then
              GetFileName 
    = mid(FullPath,InStrRev(FullPath, "")+1)
            
    Else
              GetFileName 
    = ""
            
    End If
        
    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
            SundyUpload_SourceData.position
    =FileStart
            SundyUpload_SourceData.copyto dr,FileSize
            dr.SaveToFile FullPath,
    2
            dr.Close
            
    Set dr=Nothing 
            SaveAs
    =False
        
    End Function
    End Class

    Class Progress
      
    Dim objDom,xmlPath
        
    Dim startTime
      
    Private Sub Class_Initialize

        
    End Sub
        
        
    Public Sub ProgressInit(xmlPathTmp)
          
    Dim objRoot,objChild
            
    Dim objPI

            xmlPath 
    = xmlPathTmp
            
    Set objDom = Server.CreateObject("Microsoft.XMLDOM")
            
    Set objRoot = objDom.createElement("progress")
            objDom.appendChild objRoot
            
            
    Set objChild = objDom.createElement("totalbytes")
            objChild.Text 
    = "0"
            objRoot.appendChild objChild
            
    Set objChild = objDom.createElement("uploadbytes")
            objChild.Text 
    = "0"
            objRoot.appendChild objChild
            
    Set objChild = objDom.createElement("uploadpercent")
            objChild.Text 
    = "0%"
            objRoot.appendChild objChild
            
    Set objChild = objDom.createElement("uploadspeed")
            objChild.Text 
    = "0"
            objRoot.appendChild objChild
            
    Set objChild = objDom.createElement("totaltime")
            objChild.Text 
    = "00:00:00"
            objRoot.appendChild objChild
            
    Set objChild = objDom.createElement("lefttime")
            objChild.Text 
    = "00:00:00"
            objRoot.appendChild objChild
            
            
    Set objPI = objDom.createProcessingInstruction("xml","version='1.0' encoding='utf-8'")
            objDom.insertBefore objPI, objDom.childNodes(
    0)
            objDom.Save xmlPath
            
    Set objPI = Nothing
            
    Set objChild = Nothing
            
    Set objRoot = Nothing
            
    Set objDom = Nothing
        
    End Sub
        
        
    Sub UpdateProgress(tBytes,rBytes)
          
    Dim eTime,currentTime,speed,totalTime,leftTime,percent
            
    If rBytes = 0 Then
                startTime 
    = Timer
                
    Set objDom = Server.CreateObject("Microsoft.XMLDOM")
                objDom.load(xmlPath)
                objDom.selectsinglenode(
    "//totalbytes").text=tBytes
                objDom.save(xmlPath)
            
    Else
              speed 
    = 0.0001
              currentTime 
    = Timer
            eTime 
    = currentTime - startTime
                
    If eTime>0 Then speed = rBytes / eTime
                totalTime 
    = tBytes / speed
                leftTime 
    = (tBytes - rBytes) / speed
                percent 
    = Round(rBytes *100 / tBytes)
                
    'objDom.selectsinglenode("//uploadbytes").text = rBytes
                'objDom.selectsinglenode("//uploadspeed").text = speed
                'objDom.selectsinglenode("//totaltime").text = totalTime
                'objDom.selectsinglenode("//lefttime").text = leftTime
                objDom.selectsinglenode("//uploadbytes").text = FormatFileSize(rBytes) & " / " & FormatFileSize(tBytes)
                objDom.selectsinglenode(
    "//uploadpercent").text = percent
                objDom.selectsinglenode(
    "//uploadspeed").text = FormatFileSize(speed) & "/sec"
                objDom.selectsinglenode(
    "//totaltime").text = SecToTime(totalTime)
                objDom.selectsinglenode(
    "//lefttime").text = SecToTime(leftTime)
                objDom.save(xmlPath)        
            
    End If
        
    End Sub

        
    private Function SecToTime(sec)
            
    Dim h:h = "0"
            
    Dim m:m = "0"
            
    Dim s:s = "0"
            h 
    = round(sec / 3600)
            m 
    = round( (sec mod 3600/ 60)
            s 
    = round(sec mod 60)
            
    If LEN(h)=1 Then h = "0" & h
            
    If LEN(m)=1 Then m = "0" & m
            
    If LEN(s)=1 Then s = "0" & s
            SecToTime 
    = (h & ":" & m & ":" & s)
        
    End Function
            
        
    private Function FormatFileSize(fsize)
            
    Dim radio,k,m,g,unitTMP
            k 
    = 1024
            m 
    = 1024*1024
            g 
    = 1024*1024*1024
            radio 
    = 1
            
    If Fix(fsize / g) > 0.0 Then
                unitTMP 
    = "GB"
                radio 
    = g
            
    ElseIf Fix(fsize / m) > 0 Then
                unitTMP 
    = "MB"
                radio 
    = m
            
    ElseIf Fix(fsize / k) > 0 Then
                unitTMP 
    = "KB"
                radio 
    = k
            
    Else
                unitTMP 
    = "B"
                radio 
    = 1
            
    End If
            
    If radio = 1 Then
                FormatFileSize 
    = fsize & "&nbsp;" & unitTMP
            
    Else
                FormatFileSize 
    = FormatNumber(fsize/radio,3& unitTMP
            
    End If
        
    End Function

        
    Private Sub Class_Terminate  
          
    Set objDom = Nothing
        
    End Sub
    End Class
    %
    >
    <script language="javascript">
    //启动进度条
    function startProgress(xmlPath){
      displayProgress();
        setProgressDivPos();
        setTimeout(
    "DisplayProgressBar('" + xmlPath + "')",500);
    }

    function DisplayProgressBar(xmlPath){
        var xmlDoc 
    = new ActiveXObject("Msxml2.DOMDocument.3.0");
        xmlDoc.async 
    = false;
        xmlDoc.load(xmlPath);
        
    if (xmlDoc.parseError.errorCode!=0){
            var 
    error = xmlDoc.parseError;
            alert(
    error.reason)
            setTimeout(
    "DisplayProgressBar('" + xmlPath + "')",1000);
            return;
        }
        var root 
    = xmlDoc.documentElement;   //根节点
        var totalbytes 
    = root.childNodes(0).text;
        var uploadbytes 
    = root.childNodes(1).text;
        var percent 
    = root.childNodes(2).text;
        ProgressPercent.innerHTML 
    = percent + "%";
        ProgressBar.style.width 
    = percent + "%";
        uploadSize.innerHTML 
    = uploadbytes;
      uploadSpeed.innerHTML 
    = root.childNodes(3).text;
        totalTime.innerHTML 
    = root.childNodes(4).text;
        leftTime.innerHTML 
    = root.childNodes(5).text;
        
    if (percent<100){
          setTimeout(
    "DisplayProgressBar('" + xmlPath + "')",1000);
        }
    }

    function displayProgress(){
        var objProgress 
    = document.getElementById("Progress");
      objProgress.style.display 
    = "";
    }
    function closeProgress(){
        var objProgress 
    = document.getElementById("Progress");
      objProgress.style.display 
    = "none";
    }
    function setProgressDivPos(){
        var objProgress 
    = document.getElementById("Progress");
        objProgress.style.top 
    = document.body.scrollTop+(document.body.clientHeight-document.getElementById("Progress").offsetHeight)/2
        objProgress.style.left 
    = document.body.scrollLeft+(document.body.clientWidth-document.getElementById("Progress").offsetWidth)/2;
    }
    </script>
    <style type="text/css">
    .progress {
        position: absolute;
        padding: 4px;
        top: 
    50;
        
    left400;
        font
    -family: Verdana, Helvetica, Arial, sans-serif;
        font
    -size: 12px;
         250px;
        height:100px;
        background: #FFFBD1;
        color: #3D2C05;
        border: 1px solid #
    715208;
        
    /* Mozilla proprietary */
        
    -moz-border-radius: 5px;
        
    /*-moz-opacity: 0.95*/
    }
    .progress table,.progress td{
      font
    -size:9pt;
    }

    .Bar{
      
    100%;
        height:15px;
        background
    -color:#CCCCCC;
        border: 1px inset #
    666666;
        margin
    -bottom:4px;
    }

    .ProgressPercent{
        font
    -size: 9pt;
        color: #
    000000;
        height: 15px;
        position: absolute;
        z
    -index: 20;
         
    100%;
        text
    -align: center;
    }
    .ProgressBar{
      background
    -color:#91D65C;
        1px;
        height:15px;
    }
    </style>
    <div id="Progress" style="display:none;" class="progress">
        
    <div class="bar">
            
    <div id="ProgressPercent" class="ProgressPercent">0%</div>
            
    <div id="ProgressBar" class="ProgressBar"></div>
        
    </div>
        
    <table border="0" cellspacing="0" cellpadding="2">
            
    <tr>
                
    <td>已经上传</td>
                
    <td>:</td>
                
    <td id="uploadSize"></td>
            
    </tr>
            
    <tr>
                
    <td>上传速度</td>
                
    <td>:</td>
                
    <td id="uploadSpeed">&nbsp;</td>
            
    </tr>
            
    <tr>
                
    <td>共需时间</td>
                
    <td>:</td>
                
    <td id="totalTime">&nbsp;</td>
            
    </tr>
            
    <tr>
                
    <td>剩余时间</td>
                
    <td>:</td>
                
    <td id="leftTime">&nbsp;</td>
            
    </tr>
        
    </table>
    </div>


    Example.asp代码如下:

    <%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
    <!--#include file="SundyUpload.asp"-->
    <%
    '此例子文档编码都是UTF-8,如果是其他编码的系统,请将编码转换为相应的编码,不然表单获取数据可能会乱码
    Dim objUpload,opt
    Dim xmlPath
    Dim fileFormName,objFile,counter
    opt 
    = request.QueryString("opt")
    If opt = "Upload" Then
      xmlPath 
    = Server.MapPath(request.QueryString("xmlPath"))'将虚拟路径转换为实际路径
        Set objUpload=new SundyUpload '建立上传对象
        objUpload.UploadInit xmlPath,"utf-8"
        counter 
    = 1
        Response.Write(
    "普通表单:" & objUpload.Form("normalForm"& "<BR><BR>")'获取表单数据
        For Each fileFormName In objUpload.objFile
          
    Set objFile=objUpload.objFile(fileFormName)
            fileSize 
    = objFile.FileSize
            fileName 
    = objFile.FileName
            
    If fileSize > 0 Then
                Response.Write(
    "File Size:" & fileSize & "<BR>")
                Response.Write(
    "File Name:" & objFile.FilePath & fileName & "<BR>")
                Response.Write(
    "File Description:" & objUpload.Form("fileDesc" & counter) & "<BR><BR>")
                
    'objFile.SaveAs 文件的实际路径(可以自行处理)
            End If
            counter 
    = counter + 1
        
    Next
        
    End If
    '为上载进度条数据文件(XML文件指定虚拟路径)
    '
    最好是随机的,因为可能多个人同时上载,需要不同的进度数据
    '
    这个路径需要在提交的时候传入上载组件中,以便在上载过程中更改进度数据
    '
    客户端使用Javascript来读取此XML文件,显示进度
    xmlPath = "upload/" & Timer & ".xml"
    %
    >
    <html>
    <head>
    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
    <title>Sundy Upload Progress Bar Example</title>
    <script language="javascript">
    function chkFrm(){
      var objFrm 
    = document.frmUpload;
        
    if (objFrm.file1.value=="" && objFrm.file2.value==""){
          alert(
    "请选择一个文件");
            objFrm.file1.focus();
            return 
    false;
        }
        objFrm.action 
    = "Example.asp?opt=Upload&xmlPath=<%=xmlPath%>";
        startProgress(
    '<%=xmlPath%>');//启动进度条
        return true;
    }
    </script>
    </head>

    <body>
    <form name="frmUpload" method="post" action="Example.asp" enctype="multipart/form-data" onSubmit="return chkFrm()">
    普通表单:
    <BR><input type="text" name="normalForm" size="40"><BR><BR>
    文件1:
    <BR>
    <input type="file" name="file1" size="40"></br>
    <input type="text" name="fileDesc1" size="30"><BR><BR>
    文件2:
    <BR>
    <input type="file" name="file2" size="40"></br>
    <input type="text" name="fileDesc2" size="30"><BR>
    <input type="submit" name="btnSubmit" value="submit"/>
    </form>
    </body>
    </html>

    将以上代码存为相应的文件,记得这个例子的页面编码一定要是UTF-8的,以后需要自己可以改

  • 相关阅读:
    B-树和B+树的应用:数据搜索和数据库索引【转】
    与网络编程相关的信号:
    Reactor构架模式
    EINTR错误
    通讯链路的检测方法
    背景减法——自组织算法
    数据结构7_链二叉树
    背景减法——Vibe
    操作系统2_进程控制
    操作系统1_进程控制块PCB
  • 原文地址:https://www.cnblogs.com/QDuck/p/563072.html
Copyright © 2011-2022 走看看