<%
OnErrorResumeNext
Dimr
Setr=NewRar
r.AddServer.MapPath("a.gIf")
r.AddServer.MapPath("a.txt")
r.AddServer.MapPath("test")
r.AddServer.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)
Setr=Nothing
%>
<scriptLanguage="Vbscript"Runat="server">
'-----------------------------------------------------
'描述:Asp打包類
'作者:小灰([email protected])
'鏈接:http://asp2004.nethttp://blog.csdn.net/iuhxqhttp://bbs.asp2004.net
'版本:1.0Beta
'版權:本作品可免費使用，但是請勿移除版權信息
'-----------------------------------------------------
ClassRar
Dimfiles,packname,s,s1,s2,rootpath,fso,f,buf
PrivateSubClass_Initialize
Randomize
DimranNum
ranNum=Int(90000*Rnd)+10000
packname=Year(Now)&Month(Now)&Day(Now)&Hour(Now)&Minute(Now)&Second(Now)&ranNum&".asp2004"
rootpath=Server.MapPath("./")
Setfiles=server.CreateObject("Scripting.Dictionary")
Setfso=Server.CreateObject("Scripting.FileSystemObject")
Sets=server.CreateObject("ADODB.Stream"):s.Open:s.Type=1
Sets1=server.CreateObject("ADODB.Stream"):s1.Open:s1.Type=1
Sets2=server.CreateObject("ADODB.Stream"):s2.Open:s2.Type=2
EndSub
PrivateSubClass_Terminate
s.Close:Sets=Nothing
s1.Close:Sets1=Nothing
s2.Close:Sets2=Nothing
Setfso=Nothing
EndSub
PublicSubAdd(obj)
Iffso.FileExists(obj)Then
Setf=fso.GetFile(obj)
files.Addobj,f.Size
ElseIffso.FolderExists(obj)Then
files.Addobj,-1
Setf=fso.GetFolder(obj)
Setfc=f.Files
ForEachf1infc
Add(LCase(f1.Path))
Next
EndIf
EndSub
PublicSubPack
Dimstr
a=files.Keys
b=files.Items
fori=0tofiles.count-1
Ifb(i)>=0Then
s.LoadFromFile(a(i))
buf=s.Read
IfNotIsNull(buf)Thens1.Write(buf)
EndIf