asp文件打包和释放类

打包代码来自：http://blog.sjzj.com.cn/article.asp?id=789 (单翼)
我将代码封装成了一个类，添加了一些属性及功能，可以将指定文件目录下及其子目录下的所有文件和目录打包成一个文件，以及释放相应的包文件到指定目录。有兴趣的朋友可以加入对不列入打包的文件的判定和过滤的功能等等。

<%
'*--------------------------------------------------------------------------*/
'*  文件打包和释放类 (Files Package and Relase Class) version 1.0
' *  (c) 2007 YoYo <mini125(at)gmail.com>
' *
' * YoYoPackOpCls is a class for Files Packing and Release
' *  Support web site: http://yangmingsheng.cn
' *  YoYoPackOpCls是一个对文件打包和释放的类,部分代码来自:http://blog.sjzj.com.cn/article.asp?id=789
' *  支持网站:http://yangmingsheng.cn
'示例代码(demo):
'
'打包(Packing)
'
'Set P = new YoYoPackOpCls
'P.ZipPath = Server.Mappath("test")'要打包的目录(打包不包括目录本身)
'P.PackagePath = Server.Mappath("update.xml") '包文件路径
'P.Zip'执行
'Response.Write "费时:0" & P.LoseTime & "秒<br>"
'Response.Write P.ErrorDesc'错误
'Set P = Nothing
'
'释放(release)
'
'Set P = new YoYoPackOpCls
'P.ReleasePath = Server.Mappath("t") '释放路径
'P.PackagePath = Server.Mappath("update.xml")
'P.Release
'Response.Write "费时:0" & P.LoseTime & "秒<br>"
'Response.Write P.ErrorDesc'错误
'Set P = Nothing
'------------------------------------------------------*/
Class YoYoPackOpCls
 Private XmlDom
 Private FsoObj
 Private StreamObj

 Private StartTime

 Public Property Get LoseTime
  LoseTime = FormatNumber((timer() - StartTime),3)
 End Property

 Private  ErrorCode 
 Public Property Get ErrorDesc
  ErrorDesc = ErrorCode
 End Property

 Private PReleasePath 
 Public Property Let ReleasePath(Value)
  If Value <> Empty Then
   PReleasePath = Value
   If right(PReleasePath,1)<>"" Then PReleasePath = PReleasePath & ""
  End If 
 End Property 

 Private PPackagePath
 Public Property Let PackagePath(Value)
  PPackagePath = Value
 End Property 

 Private PZipPath
 Public Property Let ZipPath(Value)
  If Value <> Empty Then
   PZipPath = Value
   If right(PZipPath,1)<>"" Then PZipPath = PZipPath & ""
  End If 
 End Property 

 Private Sub Class_Initialize 
  On Error Resume Next
  Set XmlDom = Server.CreateObject("Microsoft.XMLDOM")
  Set FsoObj = CreateObject("Scripting.FileSystemObject")
  Set StreamObj = CreateObject("ADODB.Stream")
  ReleasePath = Server.MapPath("Temp")
  ErrorCode = ""
  StartTime=timer()
 End Sub 

 Private Sub Class_Terminate
  Set XmlDom = Nothing
  Set FsoObj = Nothing
  'StreamObj.Close
  Set StreamObj = Nothing
  On Error GOTO 0
 End Sub 

 Private Sub ZipFilesSub(DirPath)
  dim objFolder
  dim objSubFolders
  dim objSubFolder
  dim objFiles
  dim objFile 
  dim pathname,TextStream,pp,Xfolder,Xfpath,Xfile,Xpath,Xstream
  dim PathNameStr
  Set objFolder=FsoObj.GetFolder(DirPath)
  XmlDom.load(PPackagePath)
  XmlDom.async=false
  Set Xfolder = XmlDom.SelectSingleNode("//root").AppendChild(XmlDom.CreateElement("folder"))
  Set Xfpath = Xfolder.AppendChild(XmlDom.CreateElement("path"))
   Xfpath.text = replace(DirPath,PZipPath,"")
   Set objFiles = objFolder.Files
    for each objFile in objFiles
     if lcase(DirPath & objFile.name) <> lcase(Request.ServerVariables("PATH_TRANSLATED")) Then
      PathNameStr = objFile.Path
      Set Xfile = XmlDom.SelectSingleNode("//root").AppendChild(XmlDom.CreateElement("file"))
      Set Xpath = Xfile.AppendChild(XmlDom.CreateElement("path"))
      Xpath.text = replace(PathNameStr,PZipPath,"")
      StreamObj.Type = 1
      StreamObj.Open()
      StreamObj.LoadFromFile(PathNameStr)
      StreamObj.position = 0
      
      Set Xstream = Xfile.AppendChild(XmlDom.CreateElement("stream"))
      Xstream.SetAttribute "xmlns:dt","urn:schemas-microsoft-com:datatypes"
      Xstream.dataType = "bin.base64"
      Xstream.nodeTypedValue = StreamObj.Read()
      Set Xpath = Nothing
      Set Xstream = Nothing
      Set Xfile = Nothing
      StreamObj.Close
     end if
    next
  XmlDom.Save(PPackagePath)
  Set Xfpath = Nothing
  Set Xfolder = Nothing
  Set objSubFolders=objFolder.Subfolders
   For Each objSubFolder In objSubFolders
    pathname = DirPath & objSubFolder.name & ""
    ZipFilesSub(pathname)
   Next
  Set objFolder=Nothing
  Set objSubFolders=Nothing
 End Sub
 '打包<yoyo ||| yangmingsheng.cn>
 Public Sub Zip
  Dim Root
  XmlDom.async = False
  Set Root = XmlDom.createProcessingInstruction("xml","version='1.0' encoding='UTF-8'")
  XmlDom.appendChild(Root)
  XmlDom.appendChild(XmlDom.CreateElement("root"))
  XmlDom.Save(PPackagePath)
  Set Root = Nothing
  If PZipPath = Empty Then 
   ErrorCode = ErrorCode & "PZipPath is empty"
   Exit Sub
  End If 
  If Not FsoObj.FolderExists(PZipPath) Then
   ErrorCode = ErrorCode & "PZipPath is not exists(PZipPath is not exists)"
   Exit Sub
  End If 
  ZipFilesSub(PZipPath)
  If Err Then
   ErrorCode = ErrorCode & Err.Description & "(" & Err.Source & ")"
   End If 
 End Sub 
 
 '释放<yoyo ||| yangmingsheng.cn>
 Public Sub Release
  Dim objNodeList
  Dim i,j
  If Not FsoObj.FolderExists(PReleasePath) Then
   FsoObj.CreateFolder(PReleasePath)
  End If 
  If Not FsoObj.FileExists(PPackagePath) Then
   ErrorCode = ErrorCode & Err.Description & "(" & Err.Source & ")"
   Exit Sub
  End If 
   XmlDom.load(PPackagePath)
   If XmlDom.readyState=4 Then
    If XmlDom.parseError.errorCode = 0 Then
      
      Set objNodeList = XmlDom.documentElement.selectNodes("//folder/path")
       
       j=objNodeList.length-1
       For i=0 To j
        If FsoObj.FolderExists(PReleasePath & objNodeList(i).text) = False Then
         FsoObj.CreateFolder(PReleasePath & objNodeList(i).text)
        End If
       Next
      Set FsoObj = Nothing
      Set objNodeList = Nothing
      Set objNodeList = XmlDom.documentElement.selectNodes("//file/path")
       j=objNodeList.length-1
       For i=0 To j
         With StreamObj
           .Type = 1
           .Open
           .Write objNodeList(i).nextSibling.nodeTypedvalue
           .SaveToFile PReleasePath & objNodeList(i).text,2
           .Close
         End With
       Next
      Set objNodeList = Nothing
    Else
     ErrorCode = ErrorCode & Err.Description & "(" & Err.Source & ")"
    End If
  End If
  If Err Then
   ErrorCode = ErrorCode & Err.Description & "(" & Err.Source & ")"
   End If 
 End Sub
End Class
%>