不用WinRar將網路空間上的檔案打包下載

來源:互聯網
上載者:User
winrar|打包|網路|下載

此方法,不建議壓縮,大檔案,

一般的小檔案壓幾個還很好用的

<%@ Language=VBScript %>
<% Option Explicit %>
<!--#include file="asptar.asp"-->
<%
Response.Buffer = True
Response.Clear
Dim Co,Temp,T,x,i,fsoBrowse,theFolder,TheSubFolders,FilePath,s,PH,objTar
Co=0
PH="./UpFile" '檔案路徑 '壓縮Upfile下的所有檔案
   Set objTar = New Tarball
   objTar.TarFilename="LvBBS_UpdateFile.rar"  '打包的名稱
   objTar.Path=PH
   set fsoBrowse=CreateObject("Scripting.FileSystemObject")
   Set theFolder=fsoBrowse.GetFolder(Server.Mappath(PH))
   Set theSubFolders=theFolder.SubFolders
   For Each T in theFolder.Files
      Temp= Temp & T.Name & "|"
      Co=Co+1
   Next
   For Each x In theSubFolders
      For Each i In X.Files
         Temp= Temp &  X.Name&"/"&i.Name&"|"
         Co=Co+1
      Next
   Next
   If Co<1 Then
      Response.Write "暫時沒有可更新的檔案下載"
   'objTar.AddMemoryFile "Sorry.txt","Not File!"
   Else
      Temp=Left(Temp,Len(Temp)-1)
      FilePath=Split(Temp,"|")
      For s=0 To Ubound(FilePath)
        objTar.AddFile Server.Mappath(PH&"/"&FilePath(s))
      Next
   If Response.IsClientConnected Then
        objTar.WriteTar
        Response.Flush
   End If
   End If
   Set ObjTar = Nothing
   Set fsoBrowse= Nothing
   Set theFolder = Nothing
   Set theSubFolders = Nothing

%>

asptar.asp

<%
' UNIX Tarball creator
' ====================
' Author: Chris Read
' Version: 1.0.1
' ====================
' Homepage: http://users.bigpond.net.au/mrjolly/
'
' This class provides the ability to archive multiple files together into a single
' distributable file called a tarball (The TAR actually stands for Tape ARchive).
' These are common UNIX files which contain uncompressed data.
'
' So what is this useful for? Well, it allows you to effectively combine multiple
' files into a single file for downloading. The TAR files are readable and extractable
' by a wide variety of tools, including the very widely distributed WinZip.
'
' This script can include two types of data in each archive, file data read from a disk,
' and also things direct from memory, like from a string. The archives support files in
' a binary structure, so you can store executable files if you need to, or just store
' text.
'
' This class was developed to assist me with a few projects and has grown with every
' implementation. Currently I use this class to tarball XML data for archival purposes
' which allows me to grab 100's of dynamically created XML files in a single download.
'
' There are a small number of properties and methods, which are outlined in the
' accompanying documentation.
'
Class Tarball
Public TarFilename   ' Resultant tarball filename

Public UserID    ' UNIX user ID
Public UserName    ' UNIX user name
Public GroupID    ' UNIX group ID
Public GroupName   ' UNIX group name

Public Permissions   ' UNIX permissions

Public BlockSize   ' Block byte size for the tarball (default=512)

Public IgnorePaths   ' Ignore any supplied paths for the tarball output
Public BasePath    ' Insert a base path with each file
Public Path

' Storage for file information
Private objFiles,TmpFileName
Private objMemoryFiles

' File list management subs, very basic stuff
Public Sub AddFile(sFilename)
  objFiles.Add sFilename,sFilename
End Sub

Public Sub RemoveFile(sFilename)
  objFiles.Remove sFilename
End Sub

Public Sub AddMemoryFile(sFilename,sContents)
  objMemoryFiles.Add sFilename,sContents
End Sub

Public Sub RemoveMemoryFile(sFilename)
  objMemoryFiles.Remove sFilename
End Sub

' Send the tarball to the browser
Public Sub WriteTar()
  Dim objStream, objInStream, lTemp, aFiles

  Set objStream = Server.CreateObject("ADODB.Stream") ' The main stream
  Set objInStream = Server.CreateObject("ADODB.Stream") ' The input stream for data
  
  objStream.Type = 2
  objStream.Charset = "x-ansi" ' Good old extended ASCII
  objStream.Open

  objInStream.Type = 2
  objInStream.Charset = "x-ansi"

  ' Go through all files stored on disk first
  aFiles = objFiles.Items
  
  For lTemp = 0 to UBound(aFiles)
   objInStream.Open
   objInStream.LoadFromFile aFiles(lTemp)
   objInStream.Position = 0
   'ExportFile aFiles(lTemp),objStream,objInStream
             TmpFileName =replace(aFiles(lTemp),Server.Mappath(Path)&"\","")
    ExportFile TmpFileName,objStream,objInStream
   objInStream.Close
  Next

  ' Now add stuff from memory
  aFiles = objMemoryFiles.Keys
  
  For lTemp = 0 to UBound(aFiles)
   objInStream.Open
   objInStream.WriteText objMemoryFiles.Item(aFiles(lTemp))
   objInStream.Position = 0
   ExportFile aFiles(lTemp),objStream,objInStream
   objInStream.Close
  Next

  objStream.WriteText String(BlockSize,Chr(0))

  ' Rewind the stream
  ' Remember to change the type back to binary, otherwise the write will truncate
  ' past the first zero byte character.
  objStream.Position = 0
  objStream.Type = 1
  ' Set all the browser stuff
  Response.AddHeader "Content-Disposition","filename=" & TarFilename
  Response.ContentType = "application/x-tar"
  Response.BinaryWrite objStream.Read
  
  ' Close it and go home
  objStream.Close
  Set objStream = Nothing
  Set objInStream = Nothing
End Sub

' Build a header for each file and send the file contents
Private Sub ExportFile(sFilename,objOutStream,objInStream)
  Dim lStart, lSum, lTemp
  
  lStart = objOutStream.Position ' Record where we are up to
  
  If IgnorePaths Then
   ' We ignore any paths prefixed to our filenames
   lTemp = InStrRev(sFilename,"\")
   if lTemp <> 0 then
    sFilename = Right(sFilename,Len(sFilename) - lTemp)
   end if
   sFilename = BasePath & sFilename
  End If
  
  ' Build the header, everything is ASCII in octal except for the data
  objOutStream.WriteText Left(sFilename & String(100,Chr(0)),100)
  objOutStream.WriteText "100" & Right("000" & Oct(Permissions),3) & " " & Chr(0) 'File mode
  objOutStream.WriteText Right(String(6," ") & CStr(UserID),6) & " " & Chr(0) 'uid
  objOutStream.WriteText Right(String(6," ") & CStr(GroupID),6) & " " & Chr(0) 'gid
  objOutStream.WriteText Right(String(11,"0") & Oct(objInStream.Size),11) & Chr(0) 'size
  objOutStream.WriteText Right(String(11,"0") & Oct(dateDiff("s","1/1/1970 10:00",now())),11) & Chr(0) 'mtime (Number of seconds since 10am on the 1st January 1970 (10am correct?)
  objOutStream.WriteText "        0" & String(100,Chr(0)) 'chksum, type flag and link name, write out all blanks so that the actual checksum will get calculated correctly
  objOutStream.WriteText "ustar  "  & Chr(0) 'magic and version
  objOutStream.WriteText Left(UserName & String(32,Chr(0)),32) 'uname
  objOutStream.WriteText Left(GroupName & String(32,Chr(0)),32) 'gname
  objOutStream.WriteText "         40 " & String(4,Chr(0)) 'devmajor, devminor
  objOutStream.WriteText String(167,Chr(0)) 'prefix and leader
  objInStream.CopyTo objOutStream ' Send the data to the stream
  
  if (objInStream.Size Mod BlockSize) > 0 then
   objOutStream.WriteText String(BlockSize - (objInStream.Size Mod BlockSize),Chr(0)) 'Padding to the nearest block byte boundary
  end if
  
  ' Calculate the checksum for the header
  lSum = 0  
  objOutStream.Position = lStart
  
  For lTemp = 1 To BlockSize
   lSum = lSum + (Asc(objOutStream.ReadText(1)) And &HFF&)
  Next
  
  ' Insert it
  objOutStream.Position = lStart + 148
  objOutStream.WriteText Right(String(7,"0") & Oct(lSum),7) & Chr(0)
  
  ' Move to the end of the stream
  objOutStream.Position = objOutStream.Size
End Sub

' Start everything off
Private Sub Class_Initialize()
  Set objFiles = Server.CreateObject("Scripting.Dictionary")
  Set objMemoryFiles = Server.CreateObject("Scripting.Dictionary")
  
  BlockSize = 512
  Permissions = 438 ' UNIX 666
  
  UserID = 0
  UserName = "root"
  GroupID = 0
  GroupName = "root"
  
  IgnorePaths = False
  BasePath = ""
  
  TarFilename = "new.tar"
End Sub

Private Sub Class_Terminate()
  Set objMemoryFiles = Nothing
  Set objFiles = Nothing
End Sub
End Class
%>



相關文章

Cloud Intelligence Leading the Digital Future

Alibaba Cloud ACtivate Online Conference, Nov. 20th & 21st, 2019 (UTC+08)

Register Now >

Starter Package

SSD Cloud server and data transfer for only $2.50 a month

Get Started >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。