asp打包类

<%
On Error Resume Next
Dim r
Set r = New Rar

r.Add Server.MapPath("a.gIf")
r.Add Server.MapPath("a.txt")
r.Add Server.MapPath("test")
r.Add Server.MapPath("file.asp")
r.packname = Server.MapPath("xxx.dat")
r.Pack
r.rootpath = Server.MapPath("xxx")
r.packname = Server.MapPath("xxx.dat")
r.UnPack

Response.Write(Err.Description)
Set r = Nothing
%>
<script Language="Vbscript" Runat="server">
'-----------------------------------------------------
' 描述: Asp打包类
' 作者: 小灰(quxiaohui_0@163.com)
' 链接: http://asp2004.net http://blog.csdn.net/iuhxq http://bbs.asp2004.net
' 版本: 1.0 Beta
' 版权: 本作品可免费使用，但是请勿移除版权信息
'-----------------------------------------------------
Class Rar
 Dim files,packname,s,s1,s2,rootpath,fso,f,buf
 Private Sub Class_Initialize
 Randomize
 Dim ranNum
 ranNum = Int(90000 * Rnd) + 10000
 packname = Year(Now)&Month(Now)&Day(Now)&Hour(Now)&Minute(Now)&Second(Now)&ranNum&".asp2004"

 rootpath = Server.MapPath("./")

 Set files = server.CreateObject("Scripting.Dictionary")
 Set fso = Server.CreateObject("Scripting.FileSystemObject")

 Set s = server.CreateObject("ADODB.Stream"):s.Open:s.Type = 1
 Set s1 = server.CreateObject("ADODB.Stream"):s1.Open:s1.Type = 1
 Set s2 = server.CreateObject("ADODB.Stream"):s2.Open:s2.Type = 2
 End Sub

 Private Sub Class_Terminate
 s.Close:Set s = Nothing
 s1.Close:Set s1 = Nothing
 s2.Close:Set s2 = Nothing

 Set fso = Nothing
 End Sub

 Public Sub Add(obj)
 If fso.FileExists(obj) Then
 Set f = fso.GetFile(obj)
 files.Add obj,f.Size
 ElseIf fso.FolderExists(obj) Then
 files.Add obj,-1
 Set f = fso.GetFolder(obj)
 Set fc = f.Files
 For Each f1 in fc
 Add(LCase(f1.Path))
 Next
 End If
 End Sub

 Public Sub Pack
 Dim str
 a = files.Keys
 b = files.Items
 for i=0 to files.count-1
 If b(i)>=0 Then
 s.LoadFromFile(a(i))
 buf = s.Read
 If Not IsNull(buf) Then s1.Write(buf)
 End If