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
% >