赶知识网

ASP无组件上载,带进度条,多文件上载

2009-08-23 / 3949次点击 asp/access/IIS/mssql
 
各种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 & " " & 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;
   left: 400;
   font-family: Verdana, Helvetica, Arial, sans-serif;
   font-size: 12px;
   width: 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{
 width: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;
   width: 100%;
   text-align: center;
}
.ProgressBar{
 background-color:#91D65C;
   width: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"> </td>
       </tr>
       <tr>
           <td>共需时间</td>
           <td>:</td>
           <td id="totalTime"> </td>
       </tr>
       <tr>
           <td>剩余时间</td>
           <td>:</td>
           <td id="leftTime"> </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>
有用 0 没用 0

Top10

沪ICP备09053415号 © 赶知识网