1. <%@ Language=VBScript %>  
2. <% Option Explicit %>  
3. <!--#include file="asptar.asp"-->  
4. <%  
5. Response.Buffer = True  
6. Response.Clear  
7. Dim Co,Temp,T,x,i,fsoBrowse,theFolder,TheSubFolders,FilePath,s,PH,objTar  
8. Co=0  
9. PH="./UpFile" '文件路徑 '壓縮Upfile下的所有文件  
10.    Set objTar = New Tarball  
11.    objTar.TarFilename="LvBBS_UpdateFile.rar"  '打包的名稱  
12.    objTar.Path=PH  
13.    set fsoBrowse=CreateObject("Scripting.FileSystemObject")  
14.    Set theFolder=fsoBrowse.GetFolder(Server.Mappath(PH))  
15.    Set theSubFolders=theFolder.SubFolders  
16.    For Each T in theFolder.Files  
17.       Temp= Temp & T.Name & "|"  
18.       Co=Co+1  
19.    Next  
20.    For Each x In theSubFolders  
21.       For Each i In X.Files  
22.          Temp= Temp &  X.Name&"/"&i.Name&"|"  
23.          Co=Co+1  
24.       Next  
25.    Next  
26.    If Co<1 Then  
27.       Response.Write "暫時(shí)沒(méi)有可更新的文件下載"  
28.    'objTar.AddMemoryFile "Sorry.txt","Not File!"  
29.    Else  
30.       Temp=Left(Temp,Len(Temp)-1)  
31.       FilePath=Split(Temp,"|")  
32.       For s=0 To Ubound(FilePath)  
33.         objTar.AddFile Server.Mappath(PH&"/"&FilePath(s))  
34.       Next  
35.    If Response.IsClientConnected Then  
36.         objTar.WriteTar  
37.         Response.Flush  
38.    End If  
39.    End If  
40.    Set ObjTar = Nothing  
41.    Set fsoBrowse= Nothing  
42.    Set theFolder = Nothing  
43.    Set theSubFolders = Nothing  
44.  
45. %>  
46.  
47. asptar.asp  
48.  
49. <%  
50. ' UNIX Tarball creator  
51. ' ====================  
52. ' Author: Chris Read  
53. ' Version: 1.0.1  
54. ' ====================  
55. '  
56. ' This class provides the ability to archive multiple files together into a single  
57. ' distributable file called a tarball (The TAR actually stands for Tape ARchive).  
58. ' These are common UNIX files which contain uncompressed data.  
59. '  
60. ' So what is this useful for? Well, it allows you to effectively combine multiple  
61. ' files into a single file for downloading. The TAR files are readable and extractable  
62. ' by a wide variety of tools, including the very widely distributed WinZip.  
63. '  
64. ' This script can include two types of data in each archive, file data read from a disk,  
65. ' and also things direct from memory, like from a string. The archives support files in   
66. ' a binary structure, so you can store executable files if you need to, or just store  
67. ' text.  
68. '  
69. ' This class was developed to assist me with a few projects and has grown with every  
70. ' implementation. Currently I use this class to tarball XML data for archival purposes  
71. ' which allows me to grab 100's of dynamically created XML files in a single download.  
72. '  
73. ' There are a small number of properties and methods, which are outlined in the  
74. ' accompanying documentation.  
75. '  
76. Class Tarball  
77. Public TarFilename   ' Resultant tarball filename  
78.  
79. Public UserID    ' UNIX user ID  
80. Public UserName    ' UNIX user name  
81. Public GroupID    ' UNIX group ID  
82. Public GroupName   ' UNIX group name  
83.  
84. Public Permissions   ' UNIX permissions  
85.  
86. Public BlockSize   ' Block byte size for the tarball (default=512)  
87.  
88. Public IgnorePaths   ' Ignore any supplied paths for the tarball output  
89. Public BasePath    ' Insert a base path with each file  
90. Public Path  
91.  
92. ' Storage for file information  
93. Private objFiles,TmpFileName  
94. Private objMemoryFiles  
95.  
96. ' File list management subs, very basic stuff  
97. Public Sub AddFile(sFilename)  
98.   objFiles.Add sFilename,sFilename  
99. End Sub  
100.  
101. Public Sub RemoveFile(sFilename)  
102.   objFiles.Remove sFilename  
103. End Sub  
104.  
105. Public Sub AddMemoryFile(sFilename,sContents)  
106.   objMemoryFiles.Add sFilename,sContents  
107. End Sub  
108.  
109. Public Sub RemoveMemoryFile(sFilename)  
110.   objMemoryFiles.Remove sFilename  
111. End Sub  
112.  
113. ' Send the tarball to the browser  
114. Public Sub WriteTar()  
115.   Dim objStream, objInStream, lTemp, aFiles  
116.  
117.   Set objStream = Server.CreateObject("ADODB.Stream") ' The main stream  
118.   Set objInStream = Server.CreateObject("ADODB.Stream") ' The input stream for data  
119.  
120.   objStream.Type = 2  
121.   objStream.Charset = "x-ansi" ' Good old extended ASCII  
122.   objStream.Open  
123.  
124.   objInStream.Type = 2  
125.   objInStream.Charset = "x-ansi"  
126.  
127.   ' Go through all files stored on disk first  
128.   aFiles = objFiles.Items  
129.  
130.   For lTemp = 0 to UBound(aFiles)  
131.    objInStream.Open  
132.    objInStream.LoadFromFile aFiles(lTemp)  
133.    objInStream.Position = 0  
134.    'ExportFile aFiles(lTemp),objStream,objInStream  
135.              TmpFileName =replace(aFiles(lTemp),Server.Mappath(Path)&"\","")  
136.     ExportFile TmpFileName,objStream,objInStream  
137.    objInStream.Close  
138.   Next  
139.  
140.   ' Now add stuff from memory  
141.   aFiles = objMemoryFiles.Keys  
142.  
143.   For lTemp = 0 to UBound(aFiles)  
144.    objInStream.Open  
145.    objInStream.WriteText objMemoryFiles.Item(aFiles(lTemp))  
146.    objInStream.Position = 0  
147.    ExportFile aFiles(lTemp),objStream,objInStream  
148.    objInStream.Close  
149.   Next  
150.  
151.   objStream.WriteText String(BlockSize,Chr(0))  
152.  
153.   ' Rewind the stream  
154.   ' Remember to change the type back to binary, otherwise the write will truncate  
155.   ' past the first zero byte character.  
156.   objStream.Position = 0  
157.   objStream.Type = 1  
158.   ' Set all the browser stuff  
159.   Response.AddHeader "Content-Disposition","filename=" & TarFilename  
160.   Response.ContentType = "application/x-tar"  
161.   Response.BinaryWrite objStream.Read  
162.  
163.   ' Close it and go home  
164.   objStream.Close  
165.   Set objStream = Nothing  
166.   Set objInStream = Nothing  
167. End Sub  
168.  
169. ' Build a header for each file and send the file contents  
170. Private Sub ExportFile(sFilename,objOutStream,objInStream)  
171.   Dim lStart, lSum, lTemp  
172.  
173.   lStart = objOutStream.Position ' Record where we are up to  
174.  
175.   If IgnorePaths Then  
176.    ' We ignore any paths prefixed to our filenames  
177.    lTemp = InStrRev(sFilename,"\")  
178.    if lTemp <> 0 then  
179.     sFilename = Right(sFilename,Len(sFilename) - lTemp)  
180.    end if  
181.    sFilename = BasePath & sFilename  
182.   End If  
183.  
184.   ' Build the header, everything is ASCII in octal except for the data  
185.   objOutStream.WriteText Left(sFilename & String(100,Chr(0)),100)  
186.   objOutStream.WriteText "100" & Right("000" & Oct(Permissions),3) & " " & Chr(0) 'File mode  
187.   objOutStream.WriteText Right(String(6," ") & CStr(UserID),6) & " " & Chr(0) 'uid  
188.   objOutStream.WriteText Right(String(6," ") & CStr(GroupID),6) & " " & Chr(0) 'gid  
189.   objOutStream.WriteText Right(String(11,"0") & Oct(objInStream.Size),11) & Chr(0) 'size  
190.   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?)  
191.   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  
192.   objOutStream.WriteText "ustar  "  & Chr(0) 'magic and version  
193.   objOutStream.WriteText Left(UserName & String(32,Chr(0)),32) 'uname  
194.   objOutStream.WriteText Left(GroupName & String(32,Chr(0)),32) 'gname  
195.   objOutStream.WriteText "         40 " & String(4,Chr(0)) 'devmajor, devminor  
196.   objOutStream.WriteText String(167,Chr(0)) 'prefix and leader  
197.   objInStream.CopyTo objOutStream ' Send the data to the stream  
198.  
199.   if (objInStream.Size Mod BlockSize) > 0 then  
200.    objOutStream.WriteText String(BlockSize - (objInStream.Size Mod BlockSize),Chr(0)) 'Padding to the nearest block byte boundary  
201.   end if  
202.  
203.   ' Calculate the checksum for the header  
204.   lSum = 0    
205.   objOutStream.Position = lStart  
206.  
207.   For lTemp = 1 To BlockSize  
208.    lSum = lSum + (Asc(objOutStream.ReadText(1)) And &HFF&)  
209.   Next  
210.  
211.   ' Insert it  
212.   objOutStream.Position = lStart + 148  
213.   objOutStream.WriteText Right(String(7,"0") & Oct(lSum),7) & Chr(0)  
214.  
215.   ' Move to the end of the stream  
216.   objOutStream.Position = objOutStream.Size  
217. End Sub  
218.  
219. ' Start everything off  
220. Private Sub Class_Initialize()  
221.   Set objFiles = Server.CreateObject("Scripting.Dictionary")  
222.   Set objMemoryFiles = Server.CreateObject("Scripting.Dictionary")  
223.  
224.   BlockSize = 512  
225.   Permissions = 438 ' UNIX 666  
226.  
227.   UserID = 0  
228.   UserName = "root"  
229.   GroupID = 0  
230.   GroupName = "root"  
231.  
232.   IgnorePaths = False  
233.   BasePath = ""  
234.  
235.   TarFilename = "new.tar"  
236. End Sub  
237.  
238. Private Sub Class_Terminate()  
239.   Set objMemoryFiles = Nothing  
240.   Set objFiles = Nothing  
241. End Sub  
242. End Class  
243. %>