-
Notifications
You must be signed in to change notification settings - Fork 2
/
CZIP.CLS
224 lines (209 loc) · 7.84 KB
/
CZIP.CLS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "cZip"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' ======================================================================================
' Name: vbAccelerator cUnzip class
' Author: Steve McMahon (steve@vbaccelerator.com)
' Date: 1 January 2000
'
' Requires: Info-ZIP's Zip32.DLL v2.32, renamed to vbzip10.dll
' mZip.bas
'
' Copyright © 2000 Steve McMahon for vbAccelerator
' --------------------------------------------------------------------------------------
' Visit vbAccelerator - advanced free source code for VB programmers
' http://vbaccelerator.com
' --------------------------------------------------------------------------------------
'
' Part of the implementation of cUnzip.cls, a class which gives a
' simple interface to Info-ZIP's excellent, free zipping library
' (Zip32.DLL).
'
' ======================================================================================
Public Enum EZPMsgLevel
ezpAllMessages = 0
ezpPartialMessages = 1
ezpNoMessages = 2
End Enum
Public Event Cancel(ByVal sMsg As String, ByRef bCancel As Boolean)
Public Event PasswordRequest(ByRef sPassword As String, ByRef bCancel As Boolean)
Public Event Progress(ByVal lCount As Long, ByVal sMsg As String)
Private m_tZPOPT As ZPOPT
Private m_sFileName As String
Private m_sFileSpecs() As String
Private m_iCount As Long
' Set zip options
' m_tZPOPT.fSuffix = 0 ' include suffixes (not yet implemented)
' m_tZPOPT.fExtra = 0 ' 1 if including extra attributes
' m_tZPOPT.date = vbNullString ' "12/31/79"? US Date?
' m_tZPOPT.fExcludeDate = 0 ' 1 if excluding files earlier than a specified date
' m_tZPOPT.fIncludeDate = 0 ' 1 if including files earlier than a specified date
' m_tZPOPT.fJunkSFX = 0 ' 1 if junking sfx prefix
' m_tZPOPT.fOffsets = 0 ' 1 if updating archive offsets for sfx Files
' m_tZPOPT.fComment = 0 ' 1 if putting comment in zip file
' m_tZPOPT.fGrow = 0 ' 1 if allow appending to zip file
' m_tZPOPT.fForce = 0 ' 1 if making entries using DOS names
' m_tZPOPT.fMove = 0 ' 1 if deleting files added or updated
' m_tZPOPT.fDeleteEntries = 0 ' 1 if files passed have to be deleted
' m_tZPOPT.fLatestTime = 0 ' 1 if setting zip file time to time of latest file in archive
' m_tZPOPT.fPrivilege = 0 ' 1 if not saving privileges
' m_tZPOPT.fEncryption = 0 'Read only property!
' m_tZPOPT.fRepair = 0 ' 1=> fix archive, 2=> try harder to fix
' m_tZPOPT.flevel = 0 ' compression level - should be 0!!!
Public Property Get ZipFile() As String
ZipFile = m_sFileName
End Property
Public Property Let ZipFile(ByVal sFileName As String)
m_sFileName = sFileName
End Property
Public Property Get BasePath() As String
BasePath = m_tZPOPT.szRootDir
End Property
Public Property Let BasePath(ByVal sBasePath As String)
m_tZPOPT.szRootDir = sBasePath
End Property
Public Property Get Encrpyt() As Boolean
Encrypt = Not (m_tZPOPT.fEncrypt = 0)
End Property
Public Property Let Encrypt(ByVal bState As Boolean)
m_tZPOPT.fEncrypt = Abs(bState)
End Property
Public Property Get IncludeSystemAndHiddenFiles() As Boolean
IncludeSystemAndHiddenFiles = Not (m_tZPOPT.fSystem = 0) ' 1 to include system/hidden files
End Property
Public Property Let IncludeSystemAndHiddenFiles(ByVal bState As Boolean)
m_tZPOPT.fSystem = Abs(bState) ' 1 to include system/hidden files
End Property
Public Property Get StoreVolumeLabel() As Boolean
StoreVolumeLabel = Not (m_tZPOPT.fVolume = 0) ' 1 if storing volume label
End Property
Public Property Let StoreVolumeLabel(ByVal bState As Boolean)
m_tZPOPT.fVolume = Abs(bState)
End Property
Public Property Get StoreDirectories() As Boolean
StoreDirectories = Not (m_tZPOPT.fNoDirEntries = 0) ' 1 if ignoring directory entries
End Property
Public Property Let StoreDirectories(ByVal bState As Boolean)
m_tZPOPT.fNoDirEntries = Abs(Not (bState))
End Property
Public Property Get StoreFolderNames() As Boolean
StoreFolderNames = (m_tZPOPT.fJunkDir = 0)
End Property
Public Property Let StoreFolderNames(ByVal bState As Boolean)
m_tZPOPT.fJunkDir = Abs(Not (bState))
End Property
Public Property Get RecurseSubDirs() As Boolean
RecurseSubDirs = Not (m_tZPOPT.fRecurse = 0) ' 1 if recursing into subdirectories
End Property
Public Property Let RecurseSubDirs(ByVal bState As Boolean)
If bState Then
m_tZPOPT.fRecurse = 2
Else
m_tZPOPT.fRecurse = 0
End If
End Property
Public Property Get UpdateOnlyIfNewer() As Boolean
UpdateOnlyIfNewer = Not (m_tZPOPT.fUpdate = 0) ' 1 if updating zip file--overwrite only if newer
End Property
Public Property Let UpdateOnlyIfNewer(ByVal bState As Boolean)
m_tZPOPT.fUpdate = Abs(bState) ' 1 if updating zip file--overwrite only if newer
End Property
Public Property Get FreshenFiles() As Boolean
FreshenFiles = Not (m_tZPOPT.fFreshen = 0) ' 1 if freshening zip file--overwrite only
End Property
Public Property Let FreshenFiles(ByVal bState As Boolean)
m_tZPOPT.fUpdate = Abs(bState) ' 1 if updating zip file--overwrite only if newer
End Property
Public Property Get MessageLevel() As EZPMsgLevel
If Not (m_tZPOPT.fVerbose = 0) Then
MessageLevel = ezpAllMessages
ElseIf Not (m_tZPOPT.fQuiet = 0) Then
MessageLevel = ezpPartialMessages
Else
MessageLevel = ezpNoMessages
End If
End Property
Public Property Let MessageLevel(ByVal eLevel As EZPMsgLevel)
Select Case eLevel
Case ezpPartialMessages
m_tZPOPT.fQuiet = 1
m_tZPOPT.fVerbose = 0
Case ezpNoMessages
m_tZPOPT.fQuiet = 0
m_tZPOPT.fVerbose = 0
Case ezpAllMessages
m_tZPOPT.fQuiet = 0
m_tZPOPT.fVerbose = 1
End Select
End Property
Public Property Get ConvertCRLFToLF() As Boolean
ConvertCRLFToLF = (m_tZPOPT.fCRLF_LF <> 0)
End Property
Public Property Let ConvertCRLFToLF(ByVal bState As Boolean)
m_tZPOPT.fCRLF_LF = Abs(bState)
End Property
Public Property Get ConvertLFToCRLF() As Boolean
ConvertLFToCRLF = (m_tZPOPT.fLF_CRLF <> 0)
End Property
Public Property Let ConvertLFToCRLF(ByVal bState As Boolean)
m_tZPOPT.fLF_CRLF = Abs(bState)
End Property
Friend Sub ProgressReport( _
ByVal sMsg As String _
)
RaiseEvent Progress(1, sMsg)
End Sub
Friend Sub PasswordRequest( _
ByRef sPassword As String, _
ByRef bCancel As Boolean _
)
RaiseEvent PasswordRequest(sPassword, bCancel)
End Sub
Friend Sub Service( _
ByVal sMsg As String, _
ByRef bCancel As Boolean _
)
RaiseEvent Cancel(sMsg, bCancel)
End Sub
Public Sub ClearFileSpecs()
m_iCount = 0
Erase m_sFileSpecs()
End Sub
Public Function AddFileSpec(ByVal sSpec As String) As Long
m_iCount = m_iCount + 1
ReDim Preserve m_sFileSpecs(1 To m_iCount) As String
m_sFileSpecs(m_iCount) = sSpec
End Function
Public Property Get FileSpecCount() As Long
FileSpecCount = m_iCount
End Property
Public Property Get FileSpec(ByVal nIndex As Long)
FileSpec = m_sFileSpecs(nIndex)
End Property
Public Property Get AllowAppend() As Boolean
AllowAppend = (m_tZPOPT.fGrow = 1)
End Property
Public Property Let AllowAppend(ByVal bState As Boolean)
m_tZPOPT.fGrow = Abs(bState)
End Property
Public Sub Zip()
mZip.VBZip Me, m_tZPOPT, m_sFileSpecs(), m_iCount
End Sub
Public Sub Delete()
' Deletes the entries specified by the file specs:
m_tZPOPT.fDeleteEntries = 1
mZip.VBZip Me, m_tZPOPT, m_sFileSpecs(), m_iCount
m_tZPOPT.fDeleteEntries = 0
End Sub
Private Sub Class_Initialize()
StoreDirectories = False
StoreFolderNames = False
RecurseSubDirs = False
End Sub