<%@ 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 ' ==================== ' ' 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 %>