上一篇  |  下一篇
WEB应用开发
Asp无组件上传带进度条演示及源码

提交页面

  1. <html> 
  2. <body> 
  3. <script language="javascript"> 
  4. var oXMLDoc = new ActiveXObject("Microsoft.XMLDOM");            //创建'MSXML'对象  
  5. oXMLDoc.async = true;    
  6. var theUniqueID= 0;  
  7. var iTimerID=null;        //这个变量是作定时器的ID  
  8.  
  9. //让数据提交的同时执行显示进度条的函数  
  10. function UploadData()      
  11. {  
  12.     theUniqueID = (new Date()).getTime() % 1000000000;  
  13.  
  14.     // 清除原始数据  
  15.     PercentDone.style.width = "0%";  
  16.     ElapsedTime.innerHTML = "";  
  17.     TimeLeft.innerHTML = "";  
  18.     SizeCompleted.innerHTML = "";  
  19.     TotalSize.innerHTML = "";  
  20.     TransferRate.innerHTML = "";  
  21.  
  22.     document.myform.action = "demo.asp?ProgressID=" + theUniqueID;  //处理上传数据的程序  
  23.     //将提交的数据放在一个名字是upload隐藏的iframe里面处理，这样提交的页面就不会跳转到处理数据的页  
  24.     document.myform.target="upload"    
  25.     document.myform.submit();     //提交表单  
  26.  
  27.     ProgressBar();      //开始执行反映上传情况的函数  
  28.  
  29. }  
  30.  
  31. function ProgressBar()  
  32. {  
  33.  
  34.       
  35.     sURL = "Progress_Xml.asp?ProgressID=" + theUniqueID + "&temp="+Math.random();      //获取上传状态数据的地址  
  36.     oXMLDoc.onreadystatechange = Function( "fnLoadComplete();" );      
  37.     oXMLDoc.load( sURL );  
  38.       
  39. }  
  40.  
  41. function fnLoadComplete()  
  42. {  
  43.     var iReadyState；  
  44.     try  
  45.     {  
  46.         iReadyState = oXMLDoc.readyState;  
  47.     }  
  48.     catch(e)  
  49.     {  
  50.         return;  
  51.     }  
  52.     if(  iReadyState != 4 ) return;  
  53.       
  54.     if( oXMLDoc == null || oXMLDoc.xml == "" )  
  55.     {  
  56.         window.status = 'Xml load fault';  
  57.         return;  
  58.     }  
  59.  
  60.     var oRoot = oXMLDoc.documentElement;     //获取返回xml数据的根节点  
  61.  
  62.     if(oRoot != null)    
  63.     {  
  64.         if (oRoot.selectSingleNode("ErrorMessage") == null)  
  65.         {  
  66.  
  67.             var readyState = oRoot.selectSingleNode("ReadyState").text;  
  68.  
  69.             // 如果还没初始化完成，继续  
  70.             if ( readyState == "uninitialized" )  
  71.             {  
  72.                 iTimerID = setTimeout("ProgressBar()", 1000);   
  73.             }  
  74.             // 上传进行中  
  75.             else if ( readyState == "loading" )              //文件上传结束就取消定时器  
  76.             {  
  77.  
  78.                 bar1.style.display = 'block';  //让显示上传进度显示的层的可见  
  79.  
  80.                 PercentDone.style.width = oRoot.selectSingleNode("Percentage").text;        //设置进度条的百分比例  
  81.                 //根据返回的数据在客户端显示  
  82.                 ElapsedTime.innerHTML = oRoot.selectSingleNode("ElapsedTime").text;       //显示剩余时间  
  83.                 TimeLeft.innerHTML = oRoot.selectSingleNode("TimeLeft").text;       //显示剩余时间  
  84.                 SizeCompleted.innerHTML = oRoot.selectSingleNode("SizeCompleted").text;    //已上传数据大小  
  85.                 TotalSize.innerHTML = oRoot.selectSingleNode("TotalSize").text;    //总大小  
  86.                 TransferRate.innerHTML=oRoot.selectSingleNode("TransferRate").text; //传输速率  
  87.  
  88.                 //这里设定时间间隔是0.5秒，你也可以根据你的情况修改获取数据时间间隔  
  89.                 iTimerID = setTimeout("ProgressBar()", 100);   
  90.             }  
  91.             // 上传结束  
  92.             else if ( readyState == "loaded" )  
  93.             {  
  94.                 PercentDone.style.width = "100%";        //设置进度条的百分比例  
  95.                 if (iTimerID != null)  
  96.                     clearTimeout(iTimerID)  
  97.                 iTimerID = null;      
  98.  
  99.                 alert("上传结束，服务器处理中...");  
  100.             }  
  101.             // 上传结束  
  102.             else  
  103.             {  
  104.                 PercentDone.style.width = "100%";        //设置进度条的百分比例  
  105.                 if (iTimerID != null)  
  106.                     clearTimeout(iTimerID)  
  107.                 iTimerID = null;      
  108.                 alert("上传结束");  
  109.             }  
  110.         }  
  111.         else  
  112.         {  
  113.             alert(oRoot.selectSingleNode("ErrorMessage").text);  
  114.             upload.location.href = "about:blank";  
  115.         }  
  116.     }  
  117.  
  118. }  
  119.  
  120. function CacelUpload()  
  121. {  
  122.     upload.location.href = "about:blank";  
  123.     if (iTimerID != null)  
  124.         clearTimeout(iTimerID)  
  125.     iTimerID = null;      
  126.     bar1.style.display = '';  
  127. }  
  128.  
  129. </script> 
  130.  
  131.    
  132. <base target="_blank"> 
  133. <form name="myform" method="post" action="demo.asp" enctype="multipart/form-data" target="upload"> 
  134. <h2>Asp无组件上传带进度条 </h2> 
  135. <HR> 
  136. 上传测试：<BR> 
  137. <input type="file" name="filefield1">(请上传小于10MB的文件)<br> 
  138. <input type="button" value="上传" onclick="UploadData()"> 
  139. <input type="button" value="取消上传" onclick="CacelUpload()"><br> 
  140. <div id=bar1 style="display:"> 
  141.     <table border="0" width="100%"> 
  142.       <tr> 
  143.         <td><b>传送:</b></td> 
  144.       </tr> 
  145.       <tr bgcolor="#999999"> 
  146.         <td> 
  147.           <table border="0" width="" cellspacing="1" bgcolor="#0033FF" id="PercentDone"> 
  148.             <tr> 
  149.               <td>&nbsp;</td> 
  150.             </tr> 
  151.           </table> 
  152.         </td> 
  153.       </tr> 
  154.       <tr> 
  155.         <td> 
  156.             <table border="0" cellpadding="0" cellspacing="0"> 
  157.                 <tr><td>总 大 小:&nbsp</td><td id="TotalSize"></td></tr> 
  158.                 <tr><td>已经上传:&nbsp</td><td id="SizeCompleted"></td></tr> 
  159.                 <tr><td>平均速率:</td><td id="TransferRate"></td></tr> 
  160.                 <tr><td>使用时间:</td><td id="ElapsedTime"></td></tr> 
  161.                 <tr><td>剩余时间:</td><td id="TimeLeft"></td></tr> 
  162.             </table> 
  163.         </td> 
  164.       </tr> 
  165.     </table> 
  166. </div> 
  167. <iframe name="upload" style="width:100%"></iframe> 
  168. </form> 
  169. </body> 
  170.  
  171. </html> 

demo.asp

  1. <!-- #include file="Upload.asp" -->  
  2.  
  3. <%  
  4.  
  5.   Server.ScriptTimeout = 9999  
  6.    
  7.   set Upload = new DoteyUpload  
  8.   Upload.MaxTotalBytes = 10 *1024 *1024    ' 最大10MB  
  9.  
  10.   Upload.ProgressID = Request.QueryString("ProgressID")  
  11.   Upload.Upload() '上传演示，不保存到硬盘  
  12.  
  13.   If Request.TotalBytes > 10 *1024 *1024 Then 
  14.     Response.Write "不要上传超过10MB的文件" 
  15.     Response.End 
  16.   End If   
  17.  
  18.   if Upload.ErrMsg <> "" then   
  19.     Response.Write(Upload.ErrMsg)  
  20.     Response.End()  
  21.   end if  
  22.  
  23.   if Upload.Files.Count > 0 then  
  24.     Items = Upload.Files.Items  
  25.   end if  
  26.  
  27.   Response.Write("您已上传 " & Upload.Files.Count & " 个文件到: " & path & "<hr>")  
  28.   for each File in Upload.Files.Items  
  29.     Response.Write("文件名: " & File.FileName & "<br>")  
  30.     Response.Write("文件大小: " & File.FileSize/1024 & " KB<br>")  
  31.     Response.Write("文件类型: " & File.FileType & "<br>")  
  32.     Response.Write("客户端路径: " & File.FilePath & "<br>")  
  33.     Response.Write("<hr>")  
  34.   next  
  35.   Response.Write("<br>")  
  36. %>  
  37.  


upload.asp

  1. <%  
  2. '-----------------------------------------------------  
  3. ' 描述: Asp无组件上传带进度条  
  4. ' 作者: 宝玉(www.webuc.net)  
  5. ' 链接: www.pspsoft.com, www.cnforums.net, blog.joycode.com, www.cnblogs.com, www.51js.com  
  6. ' 版本: 1.0 Beta  
  7. ' 版权: 本作品可免费使用，但是请勿移除版权信息  
  8. ' 推荐: asp.net上传组件(http://www.upload4asp.net/)  
  9. '-----------------------------------------------------  
  10.  
  11. Dim DoteyUpload_SourceData  
  12.  
  13. Class DoteyUpload  
  14.       
  15.     Public Files  
  16.     Public Form  
  17.     Public MaxTotalBytes  
  18.     Public Version  
  19.     Public ProgressID  
  20.     Public ErrMsg  
  21.       
  22.     Private BytesRead  
  23.     Private ChunkReadSize  
  24.     Private Info  
  25.     Private Progress  
  26.  
  27.     Private UploadProgressInfo  
  28.     Private CrLf  
  29.  
  30.     Private Sub Class_Initialize()  
  31.         Set Files = Server.CreateObject("Scripting.Dictionary")    ' 上传文件集合  
  32.         Set Form = Server.CreateObject("Scripting.Dictionary")    ' 表单集合  
  33.         UploadProgressInfo = "DoteyUploadProgressInfo"  ' Application的Key  
  34.         MaxTotalBytes = 1 *1024 *1024 *1024 ' 默认最大1G  
  35.         ChunkReadSize = 64 * 1024    ' 分块大小64K  
  36.         CrLf = Chr(13) & Chr(10)    ' 换行  
  37.  
  38.         Set DoteyUpload_SourceData = Server.CreateObject("ADODB.Stream")  
  39.         DoteyUpload_SourceData.Type = 1 ' 二进制流  
  40.         DoteyUpload_SourceData.Open  
  41.  
  42.         Version = "1.0 Beta"    ' 版本  
  43.         ErrMsg = ""    ' 错误信息  
  44.         Set Progress = New ProgressInfo  
  45.  
  46.     End Sub 
  47.  
  48.     ' 将文件根据其文件名统一保存在某路径下  
  49.     Public Sub SaveTo(path)  
  50.           
  51.         Upload()    ' 上传  
  52.  
  53.         if right(path,1) <> "/" then path = path & "/"   
  54.  
  55.         ' 遍历所有已上传文件  
  56.         For Each fileItem In Files.Items              
  57.             fileItem.SaveAs path & fileItem.FileName  
  58.         Next 
  59.  
  60.         ' 保存结束后更新进度信息  
  61.         Progress.ReadyState = "complete" '上传结束  
  62.         UpdateProgressInfo progressID  
  63.  
  64.     End Sub 
  65.  
  66.     ' 分析上传的数据，并保存到相应集合中  
  67.     Public Sub Upload ()  
  68.  
  69.         Dim TotalBytes, Boundary  
  70.         TotalBytes = Request.TotalBytes     ' 总大小  
  71.         If TotalBytes < 1 Then 
  72.             Raise("无数据传入")  
  73.             Exit Sub 
  74.         End If 
  75.         If TotalBytes > MaxTotalBytes Then 
  76.             Raise("您当前上传大小为" & TotalBytes/1000 & " K，最大允许为" & MaxTotalBytes/1024 & "K")  
  77.             Exit Sub 
  78.         End If 
  79.         Boundary = GetBoundary()  
  80.         If IsNull(Boundary) Then   
  81.             Raise("如果form中没有包括multipart/form-data上传是无效的")  
  82.             Exit Sub     ''如果form中没有包括multipart/form-data上传是无效的  
  83.         End If 
  84.         Boundary = StringToBinary(Boundary)  
  85.           
  86.         Progress.ReadyState = "loading" '开始上传  
  87.         Progress.TotalBytes = TotalBytes  
  88.         UpdateProgressInfo progressID  
  89.  
  90.         Dim DataPart, PartSize  
  91.         BytesRead = 0  
  92.  
  93.         '循环分块读取  
  94.         Do While BytesRead < TotalBytes  
  95.  
  96.             '分块读取  
  97.             PartSize = ChunkReadSize  
  98.             if PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead  
  99.             DataPart = Request.BinaryRead(PartSize)  
  100.             BytesRead = BytesRead + PartSize  
  101.  
  102.             DoteyUpload_SourceData.Write DataPart  
  103.  
  104.             Progress.UploadedBytes = BytesRead  
  105.             Progress.LastActivity = Now()  
  106.  
  107.             ' 更新进度信息  
  108.             UpdateProgressInfo progressID  
  109.  
  110.         Loop 
  111.  
  112.         ' 上传结束后更新进度信息  
  113.         Progress.ReadyState = "loaded" '上传结束  
  114.         UpdateProgressInfo progressID  
  115.  
  116.         Dim Binary  
  117.         DoteyUpload_SourceData.Position = 0  
  118.         Binary = DoteyUpload_SourceData.Read  
  119.  
  120.         Dim BoundaryStart, BoundaryEnd, PosEndOfHeader, IsBoundaryEnd  
  121.         Dim Header, bFieldContent  
  122.         Dim FieldName  
  123.         Dim File  
  124.         Dim TwoCharsAfterEndBoundary  
  125.  
  126.         BoundaryStart = InStrB(Binary, Boundary)  
  127.         BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary, 0)  
  128.  
  129.         Do While (BoundaryStart > 0 And BoundaryEnd > 0 And Not IsBoundaryEnd)  
  130.             ' 获取表单头的结束位置  
  131.             PosEndOfHeader = InStrB(BoundaryStart + LenB(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))  
  132.                           
  133.             ' 分离表单头信息，类似于：  
  134.             ' Content-Disposition: form-data; name="file1"; filename="G:\homepage.txt"  
  135.             ' Content-Type: text/plain  
  136.             Header = BinaryToString(MidB(Binary, BoundaryStart + LenB(Boundary) + 2, PosEndOfHeader - BoundaryStart - LenB(Boundary) - 2))  
  137.  
  138.             ' 分离表单内容  
  139.             bFieldContent = MidB(Binary, (PosEndOfHeader + 4), BoundaryEnd - (PosEndOfHeader + 4) - 2)  
  140.               
  141.             FieldName = GetFieldName(Header)  
  142.             ' 如果是附件  
  143.             If InStr (Header,"filename=""") > 0 Then 
  144.                 Set File = New FileInfo  
  145.                   
  146.                 ' 获取文件相关信息  
  147.                 Dim clientPath  
  148.                 clientPath = GetFileName(Header)  
  149.                 File.FileName = GetFileNameByPath(clientPath)  
  150.                 File.FileExt = GetFileExt(clientPath)  
  151.                 File.FilePath = clientPath  
  152.                 File.FileType = GetFileType(Header)  
  153.                 File.FileStart = PosEndOfHeader + 3  
  154.                 File.FileSize = BoundaryEnd - (PosEndOfHeader + 4) - 2  
  155.                 File.FormName = FieldName  
  156.  
  157.                 ' 如果该文件不为空并不存在该表单项保存之  
  158.                 If Not Files.Exists(FieldName) And File.FileSize > 0 Then 
  159.                     Files.Add FieldName, File  
  160.                 End If 
  161.             '表单数据                  
  162.             Else 
  163.                 ' 允许同名表单  
  164.                 If Form.Exists(FieldName) Then 
  165.                     Form(FieldName) = Form(FieldName) & "," & BinaryToString(bFieldContent)  
  166.                 Else 
  167.                     Form.Add FieldName, BinaryToString(bFieldContent)  
  168.                 End If 
  169.             End If 
  170.  
  171.             ' 是否结束位置  
  172.             TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, BoundaryEnd + LenB(Boundary), 2))  
  173.             IsBoundaryEnd = TwoCharsAfterEndBoundary = "--" 
  174.  
  175.             If Not IsBoundaryEnd Then ' 如果不是结尾, 继续读取下一块  
  176.                 BoundaryStart = BoundaryEnd  
  177.                 BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary)  
  178.             End If 
  179.         Loop 
  180.           
  181.         ' 解析文件结束后更新进度信息  
  182.         Progress.UploadedBytes = TotalBytes  
  183.         Progress.ReadyState = "interactive" '解析文件结束  
  184.         UpdateProgressInfo progressID  
  185.  
  186.     End Sub 
  187.  
  188.     '异常信息  
  189.     Private Sub Raise(Message)  
  190.         ErrMsg = ErrMsg & "[" & Now & "]" & Message & "<BR>" 
  191.           
  192.         Progress.ErrorMessage = Message  
  193.         UpdateProgressInfo ProgressID  
  194.           
  195.         'call Err.Raise(vbObjectError, "DoteyUpload", Message)  
  196.  
  197.     End Sub 
  198.  
  199.     ' 取边界值  
  200.     Private Function GetBoundary()  
  201.         Dim ContentType, ctArray, bArray  
  202.         ContentType = Request.ServerVariables("HTTP_CONTENT_TYPE")  
  203.         ctArray = Split(ContentType, ";")  
  204.         If Trim(ctArray(0)) = "multipart/form-data" Then 
  205.             bArray = Split(Trim(ctArray(1)), "=")  
  206.             GetBoundary = "--" & Trim(bArray(1))  
  207.         Else    '如果form中没有包括multipart/form-data上传是无效的  
  208.             GetBoundary = null  
  209.             Raise("如果form中没有包括multipart/form-data上传是无效的")  
  210.         End If 
  211.     End Function 
  212.  
  213.     ' 将二进制流转化成文本  
  214.     Private Function BinaryToString(xBinary)  
  215.         Dim Binary  
  216.         if vartype(xBinary) = 8 then Binary = MultiByteToBinary(xBinary) else Binary = xBinary  
  217.           
  218.       Dim RS, LBinary  
  219.       Const adLongVarChar = 201  
  220.       Set RS = CreateObject("ADODB.Recordset")  
  221.       LBinary = LenB(Binary)  
  222.           
  223.         if LBinary>0 then  
  224.             RS.Fields.Append "mBinary", adLongVarChar, LBinary  
  225.             RS.Open  
  226.             RS.AddNew  
  227.                 RS("mBinary").AppendChunk Binary   
  228.             RS.Update  
  229.             BinaryToString = RS("mBinary")  
  230.         Else 
  231.             BinaryToString = "" 
  232.         End If 
  233.     End Function 
  234.  
  235.  
  236.     Function MultiByteToBinary(MultiByte)  
  237.       Dim RS, LMultiByte, Binary  
  238.       Const adLongVarBinary = 205  
  239.       Set RS = CreateObject("ADODB.Recordset")  
  240.       LMultiByte = LenB(MultiByte)  
  241.         if LMultiByte>0 then  
  242.             RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte  
  243.             RS.Open  
  244.             RS.AddNew  
  245.                 RS("mBinary").AppendChunk MultiByte & ChrB(0)  
  246.             RS.Update  
  247.             Binary = RS("mBinary").GetChunk(LMultiByte)  
  248.         End If 
  249.       MultiByteToBinary = Binary  
  250.     End Function 
  251.  
  252.  
  253.     ' 字符串到二进制  
  254.     Function StringToBinary(String)  
  255.         Dim I, B  
  256.         For I=1 to len(String)  
  257.             B = B & ChrB(Asc(Mid(String,I,1)))  
  258.         Next 
  259.         StringToBinary = B  
  260.     End Function 
  261.  
  262.     '返回表单名  
  263.     Private Function GetFieldName(infoStr)  
  264.         Dim sPos, EndPos  
  265.         sPos = InStr(infoStr, "name=")  
  266.         EndPos = InStr(sPos + 6, infoStr, Chr(34) & ";")  
  267.         If EndPos = 0 Then 
  268.             EndPos = inStr(sPos + 6, infoStr, Chr(34))  
  269.         End If 
  270.         GetFieldName = Mid(infoStr, sPos + 6, endPos - _  
  271.             (sPos + 6))  
  272.     End Function 
  273.  
  274.     '返回文件名  
  275.     Private Function GetFileName(infoStr)  
  276.         Dim sPos, EndPos  
  277.         sPos = InStr(infoStr, "filename=")  
  278.         EndPos = InStr(infoStr, Chr(34) & CrLf)  
  279.         GetFileName = Mid(infoStr, sPos + 10, EndPos - _  
  280.             (sPos + 10))  
  281.     End Function 
  282.  
  283.     '返回文件的 MIME type  
  284.     Private Function GetFileType(infoStr)  
  285.         sPos = InStr(infoStr, "Content-Type: ")  
  286.         GetFileType = Mid(infoStr, sPos + 14)  
  287.     End Function 
  288.  
  289.     '根据路径获取文件名  
  290.     Private Function GetFileNameByPath(FullPath)  
  291.         Dim pos  
  292.         pos = 0  
  293.         FullPath = Replace(FullPath, "/", "\")  
  294.         pos = InStrRev(FullPath, "\") + 1  
  295.         If (pos > 0) Then 
  296.             GetFileNameByPath = Mid(FullPath, pos)  
  297.         Else 
  298.             GetFileNameByPath = FullPath  
  299.         End If 
  300.     End Function 
  301.  
  302.     '根据路径获取扩展名  
  303.     Private Function GetFileExt(FullPath)  
  304.         Dim pos  
  305.         pos = InStrRev(FullPath,".")  
  306.         if pos>0 then GetFileExt = Mid(FullPath, Pos)  
  307.     End Function 
  308.  
  309.     ' 更新进度信息  
  310.     ' 进度信息保存在Application中的ADODB.Recordset对象中  
  311.     Private Sub UpdateProgressInfo(progressID)  
  312.         Const adTypeText = 2, adDate = 7, adUnsignedInt = 19, adVarChar = 200  
  313.           
  314.         If (progressID <> "" And IsNumeric(progressID)) Then 
  315.             Application.Lock()  
  316.             if IsEmpty(Application(UploadProgressInfo)) Then 
  317.                 Set Info = Server.CreateObject("ADODB.Recordset")  
  318.                 Set Application(UploadProgressInfo) = Info  
  319.                 Info.Fields.Append "ProgressID", adUnsignedInt  
  320.                 Info.Fields.Append "StartTime", adDate  
  321.                 Info.Fields.Append "LastActivity", adDate  
  322.                 Info.Fields.Append "TotalBytes", adUnsignedInt  
  323.                 Info.Fields.Append "UploadedBytes", adUnsignedInt  
  324.                 Info.Fields.Append "ReadyState", adVarChar, 128  
  325.                 Info.Fields.Append "ErrorMessage", adVarChar, 4000  
  326.                 Info.Open   
  327.                  Info("ProgressID").Properties("Optimize") = true  
  328.                 Info.AddNew   
  329.             Else 
  330.                 Set Info = Application(UploadProgressInfo)  
  331.                 If Not Info.Eof Then 
  332.                     Info.MoveFirst()  
  333.                     Info.Find "ProgressID = " & progressID  
  334.                 End If 
  335.                 If (Info.EOF) Then 
  336.                     Info.AddNew  
  337.                 End If 
  338.             End If 
  339.  
  340.             Info("ProgressID") = clng(progressID)  
  341.             Info("StartTime") = Progress.StartTime  
  342.             Info("LastActivity") = Now()  
  343.             Info("TotalBytes") = Progress.TotalBytes  
  344.             Info("UploadedBytes") = Progress.UploadedBytes  
  345.             Info("ReadyState") = Progress.ReadyState  
  346.             Info("ErrorMessage") = Progress.ErrorMessage  
  347.             Info.Update  
  348.  
  349.             Application.UnLock  
  350.         End IF  
  351.     End Sub 
  352.  
  353.     ' 根据上传ID获取进度信息  
  354.     Public Function GetProgressInfo(progressID)  
  355.  
  356.         Dim pi, Infos  
  357.         Set pi = New ProgressInfo  
  358.         If Not IsEmpty(Application(UploadProgressInfo)) Then 
  359.             Set Infos = Application(UploadProgressInfo)  
  360.             If Not Infos.Eof Then 
  361.                 Infos.MoveFirst  
  362.                 Infos.Find "ProgressID = " & progressID  
  363.                 If Not Infos.EOF Then 
  364.                     pi.StartTime = Infos("StartTime")  
  365.                     pi.LastActivity = Infos("LastActivity")  
  366.                     pi.TotalBytes = clng(Infos("TotalBytes"))  
  367.                     pi.UploadedBytes = clng(Infos("UploadedBytes"))  
  368.                     pi.ReadyState = Trim(Infos("ReadyState"))  
  369.                     pi.ErrorMessage = Trim(Infos("ErrorMessage"))  
  370.                     Set GetProgressInfo = pi  
  371.                 End If 
  372.             End If 
  373.         End If 
  374.         Set GetProgressInfo = pi  
  375.     End Function 
  376.  
  377.     ' 移除指定的进度信息  
  378.     Private Sub RemoveProgressInfo(progressID)  
  379.         If Not IsEmpty(Application(UploadProgressInfo)) Then 
  380.             Application.Lock  
  381.             Set Info = Application(UploadProgressInfo)  
  382.             If Not Info.Eof Then 
  383.                 Info.MoveFirst  
  384.                 Info.Find "ProgressID = " & progressID  
  385.                 If  Not Info.EOF Then 
  386.                     Info.Delete  
  387.                 End If 
  388.             End If 
  389.  
  390.             ' 如果没有记录了, 直接释放, 避免'800a0bcd'错误  
  391.             If Info.RecordCount = 0 Then 
  392.                 Info.Close  
  393.                 Application.Contents.Remove UploadProgressInfo  
  394.             End If 
  395.             Application.UnLock  
  396.         End If 
  397.     End Sub 
  398.  
  399.     ' 移除指定的进度信息  
  400.     Private Sub RemoveOldProgressInfo(progressID)  
  401.         If Not IsEmpty(Application(UploadProgressInfo)) Then 
  402.             Dim L  
  403.             Application.Lock  
  404.  
  405.             Set Info = Application(UploadProgressInfo)  
  406.             Info.MoveFirst  
  407.  
  408.             Do 
  409.                 L = Info("LastActivity").Value  
  410.                 If IsEmpty(L) Then 
  411.                     Info.Delete()   
  412.                 ElseIf DateDiff("d", Now(), L) > 30 Then 
  413.                     Info.Delete()  
  414.                 End If 
  415.                 Info.MoveNext()  
  416.             Loop Until Info.EOF  
  417.  
  418.             ' 如果没有记录了, 直接释放, 避免'800a0bcd'错误  
  419.             If Info.RecordCount = 0 Then 
  420.                 Info.Close  
  421.                 Application.Contents.Remove UploadProgressInfo  
  422.             End If 
  423.             Application.UnLock  
  424.         End If 
  425.     End Sub 
  426.  
  427. End Class 
  428.  
  429. '---------------------------------------------------  
  430. ' 进度信息 类  
  431. '---------------------------------------------------  
  432. Class ProgressInfo  
  433.       
  434.     Public UploadedBytes  
  435.     Public TotalBytes  
  436.     Public StartTime  
  437.     Public LastActivity  
  438.     Public ReadyState  
  439.     Public ErrorMessage  
  440.  
  441.     Private Sub Class_Initialize()  
  442.         UploadedBytes = 0    ' 已上传大小  
  443.         TotalBytes = 0    ' 总大小  
  444.         StartTime = Now()    ' 开始时间  
  445.         LastActivity = Now()     ' 最后更新时间  
  446.         ReadyState = "uninitialized"    ' uninitialized,loading,loaded,interactive,complete  
  447.         ErrorMessage = "" 
  448.     End Sub 
  449.  
  450.     ' 总大小  
  451.     Public Property Get TotalSize  
  452.         TotalSize = FormatNumber(TotalBytes / 1024, 0, 0, 0, -1) & " K" 
  453.     End Property   
  454.  
  455.     ' 已上传大小  
  456.     Public Property Get SizeCompleted  
  457.         SizeCompleted = FormatNumber(UploadedBytes / 1024, 0, 0, 0, -1) & " K" 
  458.     End Property   
  459.  
  460.     ' 已上传秒数  
  461.     Public Property Get ElapsedSeconds  
  462.         ElapsedSeconds = DateDiff("s", StartTime, Now())  
  463.     End Property   
  464.  
  465.     ' 已上传时间  
  466.     Public Property Get ElapsedTime  
  467.         If ElapsedSeconds > 3600 then  
  468.             ElapsedTime = ElapsedSeconds \ 3600 & " 时 " & (ElapsedSeconds mod 3600) \ 60 & " 分 " & ElapsedSeconds mod 60 & " 秒" 
  469.         ElseIf ElapsedSeconds > 60 then  
  470.             ElapsedTime = ElapsedSeconds \ 60 & " 分 " & ElapsedSeconds mod 60 & " 秒" 
  471.         else  
  472.             ElapsedTime = ElapsedSeconds mod 60 & " 秒" 
  473.         End If 
  474.     End Property   
  475.  
  476.     ' 传输速率  
  477.     Public Property Get TransferRate  
  478.         If ElapsedSeconds > 0 Then 
  479.             TransferRate = FormatNumber(UploadedBytes / 1024 / ElapsedSeconds, 2, 0, 0, -1) & " K/秒" 
  480.         Else 
  481.             TransferRate = "0 K/秒" 
  482.         End If 
  483.     End Property   
  484.  
  485.     ' 完成百分比  
  486.     Public Property Get Percentage  
  487.         If TotalBytes > 0 Then 
  488.             Percentage = fix(UploadedBytes / TotalBytes * 100) & "%" 
  489.         Else 
  490.             Percentage = "0%" 
  491.         End If 
  492.     End Property   
  493.  
  494.     ' 估计剩余时间  
  495.     Public Property Get TimeLeft  
  496.         If UploadedBytes > 0 Then 
  497.             SecondsLeft = fix(ElapsedSeconds * (TotalBytes / UploadedBytes - 1))  
  498.             If SecondsLeft > 3600 then  
  499.                 TimeLeft = SecondsLeft \ 3600 & " 时 " & (SecondsLeft mod 3600) \ 60 & " 分 " & SecondsLeft mod 60 & " 秒" 
  500.             ElseIf SecondsLeft > 60 then  
  501.                 TimeLeft = SecondsLeft \ 60 & " 分 " & SecondsLeft mod 60 & " 秒" 
  502.             else  
  503.                 TimeLeft = SecondsLeft mod 60 & " 秒" 
  504.             End If 
  505.         Else 
  506.             TimeLeft = "未知" 
  507.         End If 
  508.     End Property   
  509.  
  510. End Class 
  511.  
  512. '---------------------------------------------------  
  513. ' 文件信息 类  
  514. '---------------------------------------------------  
  515. Class FileInfo  
  516.       
  517.     Dim FormName, FileName, FilePath, FileSize, FileType, FileStart, FileExt, NewFileName  
  518.  
  519.     Private Sub Class_Initialize   
  520.         FileName = ""        ' 文件名  
  521.         FilePath = ""            ' 客户端路径  
  522.         FileSize = 0            ' 文件大小  
  523.         FileStart= 0            ' 文件开始位置  
  524.         FormName = ""    ' 表单名  
  525.         FileType = ""        ' 文件Content Type  
  526.         FileExt = ""            ' 文件扩展名  
  527.         NewFileName = ""    '上传后文件名  
  528.     End Sub 
  529.  
  530.     Public Function Save()  
  531.         SaveAs(FileName)  
  532.     End Function 
  533.  
  534.     ' 保存文件  
  535.     Public Function SaveAs(fullpath)  
  536.         Dim dr  
  537.         SaveAs = false  
  538.         If trim(fullpath) = "" Or FileStart = 0 Or FileName = "" Or right(fullpath,1) = "/" Then Exit Function 
  539.           
  540.         NewFileName = GetFileNameByPath(fullpath)  
  541.  
  542.         Set dr = CreateObject("Adodb.Stream")  
  543.         dr.Mode = 3  
  544.         dr.Type = 1  
  545.         dr.Open  
  546.         DoteyUpload_SourceData.position = FileStart  
  547.         DoteyUpload_SourceData.copyto dr, FileSize  
  548.         dr.SaveToFile MapPath(FullPath), 2  
  549.         dr.Close  
  550.         set dr = nothing   
  551.         SaveAs = true  
  552.     End function  
  553.  
  554.     ' 取服务器端路径  
  555.     Private Function MapPath(Path)  
  556.         If InStr(1, Path, ":") > 0 Or Left(Path, 2) = "\\" Then 
  557.             MapPath = Path   
  558.         Else   
  559.             MapPath = Server.MapPath(Path)  
  560.         End If 
  561.     End function  
  562.  
  563.     '根据路径获取文件名  
  564.     Private Function GetFileNameByPath(FullPath)  
  565.         Dim pos  
  566.         pos = 0  
  567.         FullPath = Replace(FullPath, "/", "\")  
  568.         pos = InStrRev(FullPath, "\") + 1  
  569.         If (pos > 0) Then 
  570.             GetFileNameByPath = Mid(FullPath, pos)  
  571.         Else 
  572.             GetFileNameByPath = FullPath  
  573.         End If 
  574.     End Function 
  575.  
  576. End Class 
  577.  
  578. %> 

本日志由 flyinweb 于 2009-06-21 22:28:23 发表，目前已经被浏览 4100 次，评论 0 次；

作者添加了以下标签： Asp，无组件上传；

引用通告：http://www.517sou.net/Article/83/Trackback.ashx

评论订阅：http://www.517sou.net/Article/83/Feeds.ashx

相关文章

评论列表

    暂时没有评论
(必填)
(必填，不会被公开)