Zip And UnZip in VB 6.0

Call ZipFile("targetPath","SourcePath")
Call UnzipFile("targetPath","SourcePath")
''''''''' For Zip
Private Sub ZipFile(ByVal strTargetPath As String, ByVal strSourcePath As String)
Dim oZip As CGZipFiles
Set oZip = New CGZipFiles
With oZip
.ZipFileName = strTargetPath
.UpdatingZip = False
.AddFile(strSourcePath)
If .MakeZipFile <> 0 Then
MsgBox.GetLastMessage() ' any errors
End If
End With
Set oZip = Nothing
Exit Sub
End Sub

''' for UnZip
Private Sub UnzipFile(ByVal strZipName As String, ByVal strExtractDir As String)
Dim oUnZip As CGUnzipFiles
oUnZip = New CGUnzipFiles
With oUnZip
.ZipFileName = strZipName
.ExtractDir = strExtractDir
.HonorDirectories = False
If .Unzip <> 0 Then
MsgBox.GetLastMessage()
End If
End With
oUnZip = Nothing
Exit Sub
End Sub
''''' Class For Ziping
Option Explicit
Public Enum ZTranslate
CRLFtoLF = 1
LFtoCRLF = 2
End Enum
Private mCollection As Collection
Private miRecurseFolders As Integer
Private msZipFileName As String
Private miEncrypt As Integer
Private miSystem As Integer
'
Private msRootDirectory As String
Private miVerbose As Integer
Private miQuiet As Integer
Private miTranslateCRLF As ZTranslate
'
Private miUpdateZip As Integer
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 Property Get RecurseFolders() As Boolean
RecurseFolders = miRecurseFolders = 1
End Property
Public Property Let RecurseFolders(ByVal bRecurse As Boolean)
miRecurseFolders = IIf(bRecurse, 1, 0)
End Property
Public Property Get ZipFileName() As String
ZipFileName = msZipFileName
End Property
Public Property Let ZipFileName(ByVal sZipFileName As String)
msZipFileName = sZipFileName '& vbNullChar
End Property
Public Property Get Encrypted() As Boolean
Encrypted = miEncrypt = 1
End Property
Public Property Let Encrypted(ByVal bEncrypt As Boolean)
miEncrypt = IIf(bEncrypt, 1, 0)
End Property
Public Property Get IncludeSystemFiles() As Boolean
IncludeSystemFiles = miSystem = 1
End Property
Public Property Let IncludeSystemFiles(ByVal bInclude As Boolean)
miSystem = IIf(bInclude, 1, 0)
End Property
Public Property Get ZipFileCount() As Long
If mCollection Is Nothing Then
ZipFileCount = 0
Else
ZipFileCount = mCollection.Count - 1
End If
End Property

Public Property Get RootDirectory() As String
RootDirectory = msRootDirectory
End Property
Public Property Let RootDirectory(ByVal sRootDir As String)
msRootDirectory = sRootDir ' & vbNullChar
End Property
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 AddFile(ByVal sFileName As String)
Dim lCount As Long
Dim sFile As String
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
End Function
Public Function RemoveFile(ByVal sFileName As String)
Dim lCount As Long
Dim sFile As String
On Error Resume Next
sFile = mCollection.Item(sFileName)
If Len(sFile) = 0 Then
Err.Raise vbObjectError + 2002, "CGZip::RemoveFile", "File is not in Zip List"
Else
mCollection.Remove sFileName
End If
End Function
Public Function MakeZipFile() As Long
Dim zFileArray As ZIPnames
Dim sFileName As Variant
Dim lFileCount As Long
Dim iIgnorePath As Integer
Dim iRecurse As Integer
On Error GoTo vbErrorHandler

lFileCount = 0
For Each sFileName In mCollection
zFileArray.s(lFileCount) = sFileName
lFileCount = lFileCount + 1
Next
MakeZipFile = VBZip(CInt(lFileCount), msZipFileName, _
zFileArray, iIgnorePath, _
miRecurseFolders, miUpdateZip, _
0, msRootDirectory)
Exit Function
vbErrorHandler:
MakeZipFile = -99
Err.Raise Err.Number, "CGZipFiles::MakeZipFile", Err.Description
End Function
Public Function GetLastMessage() As String
GetLastMessage = msOutput
End Function
Private Sub cmdZip_Click()
Dim oZip As CGZipFiles

Set oZip = New CGZipFiles
With oZip
.ZipFileName = App.Path & "\ZIPTEST.ZIP"

.UpdatingZip = False
.AddFile App.Path & "\*.*"
If .MakeZipFile <> 0 Then
MsgBox .GetLastMessage ' any errors
End If
End With
Set oZip = Nothing
MsgBox "\ZIPTEST.ZIP Created Successfully"
Exit Sub

End Sub

''''''''''''' Class For Unziping
Option Explicit
'
'
Public Enum ZMessageLevel
All = 0
less = 1
NoMessages = 2
End Enum
Public Enum ZExtractType
Extract = 0
ListContents = 1
End Enum
Public Enum ZPrivilege
Ignore = 0
ACL = 1
Privileges = 2
End Enum
Private miExtractNewer As Integer ' 1 = Extract Only Newer, Else 0
Private miSpaceUnderScore As Integer ' 1 = Convert Space To Underscore, Else 0
Private miPromptOverwrite As Integer ' 1 = Prompt To Overwrite Required, Else 0
Private miQuiet As ZMessageLevel ' 2 = No Messages, 1 = Less, 0 = All
Private miWriteStdOut As Integer ' 1 = Write To Stdout, Else 0
Private miTestZip As Integer ' 1 = Test Zip File, Else 0
Private miExtractList As ZExtractType ' 0 = Extract, 1 = List Contents
Private miExtractOnlyNewer As Integer ' 1 = Extract Only Newer, Else 0
Private miDisplayComment As Integer ' 1 = Display Zip File Comment, Else 0
Private miHonorDirectories As Integer ' 1 = Honor Directories, Else 0
Private miOverWriteFiles As Integer ' 1 = Overwrite Files, Else 0
Private miConvertCR_CRLF As Integer ' 1 = Convert CR To CRLF, Else 0
Private miVerbose As Integer ' 1 = Zip Info Verbose
Private miCaseSensitivity As Integer ' 1 = Case Insensitivity, 0 = Case Sensitivity
Private miPrivilege As ZPrivilege ' 1 = ACL, 2 = Privileges, Else 0
Private msZipFileName As String ' The Zip File Name
Private msExtractDir As String ' Extraction Directory, Null If Current Directory
Public Property Get ExtractNewer() As Boolean
ExtractNewer = miExtractNewer = 1
End Property
Public Property Let ExtractNewer(ByVal bExtractNewer As Boolean)
miExtractNewer = IIf(bExtractNewer, 1, 0)
End Property
Public Property Get SpaceToUnderScore() As Boolean
SpaceToUnderScore = miSpaceUnderScore = 1
End Property
Public Property Let SpaceToUnderScore(ByVal bConvert As Boolean)
miSpaceUnderScore = IIf(bConvert, 1, 0)
End Property
Public Property Get PromptOverwrite() As Boolean
PromptOverwrite = miPromptOverwrite = 1
End Property
Public Property Let PromptOverwrite(ByVal bPrompt As Boolean)
miPromptOverwrite = IIf(bPrompt, 1, 0)
End Property
Public Property Get MessageLevel() As ZMessageLevel
MessageLevel = miQuiet
End Property
Public Property Let MessageLevel(ByVal iLevel As ZMessageLevel)
miQuiet = iLevel
End Property
Public Property Get WriteToStdOut() As Boolean
WriteToStdOut = miWriteStdOut = 1
End Property
Public Property Let WriteToStdOut(ByVal bWrite As Boolean)
miWriteStdOut = IIf(bWrite, 1, 0)
End Property
Public Property Get TestZip() As Boolean
TestZip = miTestZip = 1
End Property
Public Property Let TestZip(ByVal bTest As Boolean)
miTestZip = IIf(bTest, 1, 0)
End Property
Public Property Get ExtractList() As ZExtractType
ExtractList = miExtractList
End Property
Public Property Let ExtractList(ByVal zExType As ZExtractType)
miExtractList = zExType
End Property
Public Property Get ExtractOnlyNewer() As Boolean
ExtractOnlyNewer = miExtractOnlyNewer = 1
End Property
Public Property Let ExtractOnlyNewer(ByVal bOnlyNewer As Boolean)
miExtractOnlyNewer = IIf(bOnlyNewer, 1, 0)
End Property
Public Property Get DisplayComment() As Boolean
DisplayComment = miDisplayComment = 1
End Property
Public Property Let DisplayComment(ByVal bDisplay As Boolean)
miDisplayComment = IIf(bDisplay, 1, 0)
End Property
Public Property Get HonorDirectories() As Boolean
HonorDirectories = miHonorDirectories = 1
End Property
Public Property Let HonorDirectories(ByVal bHonor As Boolean)
miHonorDirectories = IIf(bHonor, 1, 0)
End Property
Public Property Get OverWriteFiles() As Boolean
OverWriteFiles = miOverWriteFiles = 1
End Property
Public Property Let OverWriteFiles(ByVal bOverWrite As Boolean)
miOverWriteFiles = IIf(bOverWrite, 1, 0)
End Property
Public Property Get ConvertCRtoCRLF() As Boolean
ConvertCRtoCRLF = miConvertCR_CRLF = 1
End Property
Public Property Let ConvertCRtoCRLF(ByVal bConvert As Boolean)
miConvertCR_CRLF = IIf(bConvert, 1, 0)
End Property
Public Property Get Verbose() As Boolean
Verbose = miVerbose = 1
End Property
Public Property Let Verbose(ByVal bVerbose As Boolean)
miVerbose = IIf(bVerbose, 1, 0)
End Property
Public Property Get CaseSensitive() As Boolean
CaseSensitive = miCaseSensitivity = 1
End Property
Public Property Let CaseSensitive(ByVal bCaseSensitive As Boolean)
miCaseSensitivity = IIf(bCaseSensitive, 1, 0)
End Property
Public Property Get Privilege() As ZPrivilege
Privilege = miPrivilege
End Property
Public Property Let Privilege(ByVal zPriv As ZPrivilege)
miPrivilege = zPriv
End Property
Public Property Get ZipFileName() As String
ZipFileName = msZipFileName
End Property
Public Property Let ZipFileName(ByVal sZipFileName As String)
msZipFileName = sZipFileName
End Property
Public Property Get ExtractDir() As String
ExtractDir = msExtractDir
End Property
Public Property Let ExtractDir(ByVal sExtractDir As String)
msExtractDir = sExtractDir
End Property
Public Function Unzip(Optional sZipFileName As String, _
Optional sExtractDir As String) As Long
On Error GoTo vbErrorHandler
Dim lRet As Long
If Len(sZipFileName) > 0 Then
msZipFileName = sZipFileName
End If
If Len(sExtractDir) > 0 Then
msExtractDir = sExtractDir
End If
lRet = VBUnzip(msZipFileName, msExtractDir, miExtractNewer, _
miSpaceUnderScore, miPromptOverwrite, CInt(miQuiet), _
miWriteStdOut, miTestZip, CInt(miExtractList), _
miExtractOnlyNewer, miDisplayComment, miHonorDirectories, _
miOverWriteFiles, miConvertCR_CRLF, miVerbose, _
miCaseSensitivity, CInt(miPrivilege))
Unzip = lRet
Exit Function
vbErrorHandler:
Err.Raise Err.Number, "CGUnZipFiles::Unzip", Err.Description
End Function
Private Sub Class_Initialize()
miExtractNewer = 0
miSpaceUnderScore = 0
miPromptOverwrite = 0
miQuiet = NoMessages
miWriteStdOut = 0
miTestZip = 0
miExtractList = Extract
miExtractOnlyNewer = 0
miDisplayComment = 0
miHonorDirectories = 1
miOverWriteFiles = 1
miConvertCR_CRLF = 0
miVerbose = 0
miCaseSensitivity = 1
miPrivilege = Ignore
End Sub
Public Function GetLastMessage() As String
GetLastMessage = msOutput
End Function