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打包类
' 作者: 小灰([e-mail])
' 链接: 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
 str = str & b(i)&">"&replace(a(i),rootpath,"")&vbcrlf
 next
 str = cstr(right("000000000"&len(str),10)) & str
 buf = texttostream(str)
 s.position = 0
 s.write buf
 s1.position = 0
 s.write s1.read
 s.seteos
 s.savetofile(packname)
 end sub

 public sub unpack

 if not fso.folderexists(rootpath) then
 fso.createfolder(rootpath)
 end if
 dim size
 '转换文件大小
 s.loadfromfile(packname)
 size = cint(streamtotext(s.read(10)))
 str = streamtotext(s.read(size))
 arr = split(str,vbcrlf)

 for i=0 to ubound(arr)-1
 arrfile = split(arr(i),">")
 if arrfile(0) < 0 then
 if not fso.folderexists(rootpath&arrfile(1)) then
 fso.createfolder(rootpath&arrfile(1))
 end if
 elseif arrfile(0) >= 0 then
 if fso.fileexists(rootpath&arrfile(1)) then
 fso.deletefile(rootpath&arrfile(1))
 end if
 s1.position = 0
 buf = s.read(arrfile(0))
 if not isnull(buf) then s1.write(buf)
 s1.seteos
 s1.savetofile(rootpath&arrfile(1))
 end if
 next
 end sub

 public function streamtotext(stream)
 if isnull(stream) then
 streamtotext = ""
 else
 set sm = server.createobject("adodb.stream"):sm.open:sm.type = 1
 sm.write(stream)
 sm.position = 0
 sm.type = 2
 sm.charset = "gb2312"
 sm.position = 0
 streamtotext = sm.readtext()
 sm.close:set sm = nothing
 end if
 end function

 public function texttostream(text)
 if text="" then
 texttostream = "" '这里该如何写？空流？
 else
 set sm = server.createobject("adodb.stream"):sm.open:sm.type = 2:sm.charset = "gb2312"
 sm.writetext(text)
 sm.position = 0
 sm.type = 1
 sm.position = 0
 texttostream = sm.read
 sm.close:set sm = nothing
 end if
 end function
end class
</script>