cgzipfiles.cls

一个可以生成ZIP的解压缩和被解压缩的DLL,这是本人在2001年刚学完VB后写的,我认为对初学者编好DLL很有意义

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "OIRZIP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Public Enum ZTranslate
    CRLFtoLF = 1
    LFtoCRLF = 2
End Enum
Private mCollection                     As Collection   ' Collection of Files to Zip
Private miEncrypt                       As Integer      ' Encryption ?
Private miQuiet                         As Integer      ' Quiet Zip
Private miRecurseFolders                As Integer      ' Recurse Folders ?
Private miSystem                        As Integer      ' System Files
Private miVerbose                       As Integer      ' Verbose Zip
Private miUpdateZip                     As Integer      ' Updating Existing Zip ?
Private msZipFileName                   As String       ' Zip File Name
Private msRootDirectory                 As String       ' Root Directory
Private miTranslateCRLF                 As ZTranslate   ' Translate CRLF / LF Chars
Private Sub Class_Initialize()
   Set mCollection = New Collection
    mCollection.Add "querty", "querty"
    miEncrypt = 0
    miSystem = 0
    msRootDirectory = "\"
    miQuiet = 0
    miUpdateZip = 0
End Sub
Private Sub Class_Terminate()

    Set mCollection = Nothing
    
End Sub

Public Function unzip(zipname As String, extdir As String)
Call vbUnzip(zipname, extdir, 1, 1, 0, 1, 0, 1)
End Function
Function GetFileName(FileName As String, Getdir As String) As String
Call vbUnzip(FileName, Getdir, 1, 1, 1, 1, 0, 1)
 GetFileName = LGetFileName()

End Function


Public Property Get ZipFileName() As String
    
    ZipFileName = msZipFileName

End Property

Public Function ZipFile(ByVal sZipFileName As String, ByVal FileName As String) As Long
Dim lCount                          As Long
Dim sFile                           As String
Dim iIgnorePath                     As Integer
Dim iRecurse                        As Integer
Dim lFileCount                      As Long
Dim sFileName                       As Variant
Dim zFileArray                      As ZIPnames
Dim fso As FileSystemObject
Set fso = New FileSystemObject
msZipFileName = sZipFileName
sFileName = FileName

If fso.FileExists(msZipFileName) = True Then
i = MsgBox("文件已经存在是否覆盖", vbYesNo)
If i = vbYes Then
fso.DeleteFile (msZipFileName)
End If
End If
miUpdateZip = 0
On Error Resume Next
    sFile = mCollection.Item(sFileName)
    
    If Len(sFile) = 0 Then
        Err.Clear
        On Error GoTo 0
        mCollection.Add sFileName, sFileName
    Else
        On Error GoTo 0
        Err.Raise vbObjectError + 2001, "CGZip::AddFile", "File is already in Zip List"
    End If
On Error Resume Next
    lFileCount = 0
    
    For Each sFileName In mCollection
        zFileArray.s(lFileCount) = sFileName
        lFileCount = lFileCount + 1
    Next
        
        iIgnorePath = 1 '如果为0则带目录压缩，为1不带目录压缩。
        
        
        
    ZipFile = VBZip(CInt(lFileCount), _
                        msZipFileName, _
                        zFileArray, _
                        iIgnorePath, _
                        miRecurseFolders, _
                        miUpdateZip, _
                        0, _
                        msRootDirectory)
                    
    


    


End Function
Public Property Get UpdatingZip() As Boolean
    
    UpdatingZip = miUpdateZip = 1

End Property

Public Property Let UpdatingZip(ByVal bUpdating As Boolean)
    
    miUpdateZip = IIf(bUpdating, 1, 0)

End Property
Public Function GetLastMessage() As String
    
    GetLastMessage = msOutput

End Function