打包下载网站内的文件夹 今天写的一个自动打包文件夹的程序包,可以直接下载。
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%> <% Option Explicit %> <!--#include file="admin_rarinc.asp"--> <% Response.Buffer = True Response.Clear Dim Co,Temp,T,x,i,fsoBrowse,theFolder,TheSubFolders,FilePath,s,PH,objTar Co=0 PH="download" '压缩该路径下的所有文件 Set objTar = New Tarball objTar.TarFilename="download.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 %> ----------------------------------------------------------admin_rarinc.asp---------------------------------------------------------- <% 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 %> |
Music
Announcement
New Visitor
About/Statistics
用户名称:陈永勤 会员等级:普通会员 实时积分:1163 日志总数:57 评论数量:83 建立时间:2009年03月20日 |