"SfR Fresh" - the SfR Freeware/Shareware Archive 
Member "vb/VBZipBas.bas" of archive zip232dN.zip:
As a special service "SfR Fresh" has tried to format the requested source page into HTML format using (guessed) Visual Basic source code syntax highlighting with prefixed line numbers.
Alternatively you can here view or download the uninterpreted source code file.
That can be also achieved for any archive member file by clicking within an archive contents listing on the first character of the file(path) respectively on the according byte size field.
1 Attribute VB_Name = "VBZipBas"
2
3 Option Explicit
4
5 '---------------------------------------------------------------
6 '-- Please Do Not Remove These Comments!!!
7 '---------------------------------------------------------------
8 '-- Sample VB 5 code to drive zip32.dll
9 '-- Contributed to the Info-ZIP project by Mike Le Voi
10 '--
11 '-- Contact me at: mlevoi@modemss.brisnet.org.au
12 '--
13 '-- Visit my home page at: http://modemss.brisnet.org.au/~mlevoi
14 '--
15 '-- Use this code at your own risk. Nothing implied or warranted
16 '-- to work on your machine :-)
17 '---------------------------------------------------------------
18 '--
19 '-- The Source Code Is Freely Available From Info-ZIP At:
20 '-- http://www.cdrom.com/pub/infozip/infozip.html
21 '--
22 '-- A Very Special Thanks To Mr. Mike Le Voi
23 '-- And Mr. Mike White Of The Info-ZIP
24 '-- For Letting Me Use And Modify His Orginal
25 '-- Visual Basic 5.0 Code! Thank You Mike Le Voi.
26 '---------------------------------------------------------------
27 '--
28 '-- Contributed To The Info-ZIP Project By Raymond L. King
29 '-- Modified June 21, 1998
30 '-- By Raymond L. King
31 '-- Custom Software Designers
32 '--
33 '-- Contact Me At: king@ntplx.net
34 '-- ICQ 434355
35 '-- Or Visit Our Home Page At: http://www.ntplx.net/~king
36 '--
37 '---------------------------------------------------------------
38 '
39 ' This is the original example with some small changes. Only
40 ' use with the original Zip32.dll (Zip 2.3). Do not use this VB
41 ' example with Zip32z64.dll (Zip 3.0).
42 '
43 ' 4/29/2004 Ed Gordon
44
45 '---------------------------------------------------------------
46 ' Usage notes:
47 '
48 ' This code uses Zip32.dll. You DO NOT need to register the
49 ' DLL to use it. You also DO NOT need to reference it in your
50 ' VB project. You DO have to copy the DLL to your SYSTEM
51 ' directory, your VB project directory, or place it in a directory
52 ' on your command PATH.
53 '
54 ' A bug has been found in the Zip32.dll when called from VB. If
55 ' you try to pass any values other than NULL in the ZPOPT strings
56 ' Date, szRootDir, or szTempDir they get converted from the
57 ' VB internal wide character format to temporary byte strings by
58 ' the calling interface as they are supposed to. However when
59 ' ZpSetOptions returns the passed strings are deallocated unless the
60 ' VB debugger prevents it by a break between ZpSetOptions and
61 ' ZpArchive. When Zip32.dll uses these pointers later it
62 ' can result in unpredictable behavior. A kluge is available
63 ' for Zip32.dll, just replacing api.c in Zip 2.3, but better to just
64 ' use the new Zip32z64.dll where these bugs are fixed. However,
65 ' the kluge has been added to Zip 2.31. To determine the version
66 ' of the dll you have right click on it, select the Version tab,
67 ' and verify the Product Version is at least 2.31.
68 '
69 ' Another bug is where -R is used with some other options and can
70 ' crash the dll. This is a bug in how zip processes the command
71 ' line and should be mostly fixed in Zip 2.31. If you run into
72 ' problems try using -r instead for recursion. The bug is fixed
73 ' in Zip 3.0 but note that Zip 3.0 creates dll zip32z64.dll and
74 ' it is not compatible with older VB including this example. See
75 ' the new VB example code included with Zip 3.0 for calling
76 ' interface changes.
77 '
78 ' Note that Zip32 is probably not thread safe. It may be made
79 ' thread safe in a later version, but for now only one thread in
80 ' one program should use the DLL at a time. Unlike Zip, UnZip is
81 ' probably thread safe, but an exception to this has been
82 ' found. See the UnZip documentation for the latest on this.
83 '
84 ' All code in this VB project is provided under the Info-Zip license.
85 '
86 ' If you have any questions please contact Info-Zip at
87 ' http://www.info-zip.org.
88 '
89 ' 4/29/2004 EG (Updated 3/1/2005 EG)
90 '
91 '---------------------------------------------------------------
92
93
94 '-- C Style argv
95 '-- Holds The Zip Archive Filenames
96 ' Max for this just over 8000 as each pointer takes up 4 bytes and
97 ' VB only allows 32 kB of local variables and that includes function
98 ' parameters. - 3/19/2004 EG
99 '
100 Public Type ZIPnames
101 zFiles(0 To 99) As String
102 End Type
103
104 '-- Call Back "String"
105 Public Type ZipCBChar
106 ch(4096) As Byte
107 End Type
108
109 '-- ZPOPT Is Used To Set The Options In The ZIP32.DLL
110 Public Type ZPOPT
111 Date As String ' US Date (8 Bytes Long) "12/31/98"?
112 szRootDir As String ' Root Directory Pathname (Up To 256 Bytes Long)
113 szTempDir As String ' Temp Directory Pathname (Up To 256 Bytes Long)
114 fTemp As Long ' 1 If Temp dir Wanted, Else 0
115 fSuffix As Long ' Include Suffixes (Not Yet Implemented!)
116 fEncrypt As Long ' 1 If Encryption Wanted, Else 0
117 fSystem As Long ' 1 To Include System/Hidden Files, Else 0
118 fVolume As Long ' 1 If Storing Volume Label, Else 0
119 fExtra As Long ' 1 If Excluding Extra Attributes, Else 0
120 fNoDirEntries As Long ' 1 If Ignoring Directory Entries, Else 0
121 fExcludeDate As Long ' 1 If Excluding Files Earlier Than Specified Date, Else 0
122 fIncludeDate As Long ' 1 If Including Files Earlier Than Specified Date, Else 0
123 fVerbose As Long ' 1 If Full Messages Wanted, Else 0
124 fQuiet As Long ' 1 If Minimum Messages Wanted, Else 0
125 fCRLF_LF As Long ' 1 If Translate CR/LF To LF, Else 0
126 fLF_CRLF As Long ' 1 If Translate LF To CR/LF, Else 0
127 fJunkDir As Long ' 1 If Junking Directory Names, Else 0
128 fGrow As Long ' 1 If Allow Appending To Zip File, Else 0
129 fForce As Long ' 1 If Making Entries Using DOS File Names, Else 0
130 fMove As Long ' 1 If Deleting Files Added Or Updated, Else 0
131 fDeleteEntries As Long ' 1 If Files Passed Have To Be Deleted, Else 0
132 fUpdate As Long ' 1 If Updating Zip File-Overwrite Only If Newer, Else 0
133 fFreshen As Long ' 1 If Freshing Zip File-Overwrite Only, Else 0
134 fJunkSFX As Long ' 1 If Junking SFX Prefix, Else 0
135 fLatestTime As Long ' 1 If Setting Zip File Time To Time Of Latest File In Archive, Else 0
136 fComment As Long ' 1 If Putting Comment In Zip File, Else 0
137 fOffsets As Long ' 1 If Updating Archive Offsets For SFX Files, Else 0
138 fPrivilege As Long ' 1 If Not Saving Privileges, Else 0
139 fEncryption As Long ' Read Only Property!!!
140 fRecurse As Long ' 1 (-r), 2 (-R) If Recursing Into Sub-Directories, Else 0
141 fRepair As Long ' 1 = Fix Archive, 2 = Try Harder To Fix, Else 0
142 flevel As Byte ' Compression Level - 0 = Stored 6 = Default 9 = Max
143 End Type
144
145 '-- This Structure Is Used For The ZIP32.DLL Function Callbacks
146 Public Type ZIPUSERFUNCTIONS
147 ZDLLPrnt As Long ' Callback ZIP32.DLL Print Function
148 ZDLLCOMMENT As Long ' Callback ZIP32.DLL Comment Function
149 ZDLLPASSWORD As Long ' Callback ZIP32.DLL Password Function
150 ZDLLSERVICE As Long ' Callback ZIP32.DLL Service Function
151 End Type
152
153 '-- Local Declarations
154 Public ZOPT As ZPOPT
155 Public ZUSER As ZIPUSERFUNCTIONS
156
157 '-- This Assumes ZIP32.DLL Is In Your \Windows\System Directory!
158 '-- (alternatively, a copy of ZIP32.DLL needs to be located in the program
159 '-- directory or in some other directory listed in PATH.)
160 Private Declare Function ZpInit Lib "zip32.dll" _
161 (ByRef Zipfun As ZIPUSERFUNCTIONS) As Long '-- Set Zip Callbacks
162
163 Private Declare Function ZpSetOptions Lib "zip32.dll" _
164 (ByRef Opts As ZPOPT) As Long '-- Set Zip Options
165
166 Private Declare Function ZpGetOptions Lib "zip32.dll" _
167 () As ZPOPT '-- Used To Check Encryption Flag Only
168
169 Private Declare Function ZpArchive Lib "zip32.dll" _
170 (ByVal argc As Long, ByVal funame As String, _
171 ByRef argv As ZIPnames) As Long '-- Real Zipping Action
172
173 '-------------------------------------------------------
174 '-- Public Variables For Setting The ZPOPT Structure...
175 '-- (WARNING!!!) You Must Set The Options That You
176 '-- Want The ZIP32.DLL To Do!
177 '-- Before Calling VBZip32!
178 '--
179 '-- NOTE: See The Above ZPOPT Structure Or The VBZip32
180 '-- Function, For The Meaning Of These Variables
181 '-- And How To Use And Set Them!!!
182 '-- These Parameters Must Be Set Before The Actual Call
183 '-- To The VBZip32 Function!
184 '-------------------------------------------------------
185 Public zDate As String
186 Public zRootDir As String
187 Public zTempDir As String
188 Public zSuffix As Integer
189 Public zEncrypt As Integer
190 Public zSystem As Integer
191 Public zVolume As Integer
192 Public zExtra As Integer
193 Public zNoDirEntries As Integer
194 Public zExcludeDate As Integer
195 Public zIncludeDate As Integer
196 Public zVerbose As Integer
197 Public zQuiet As Integer
198 Public zCRLF_LF As Integer
199 Public zLF_CRLF As Integer
200 Public zJunkDir As Integer
201 Public zRecurse As Integer
202 Public zGrow As Integer
203 Public zForce As Integer
204 Public zMove As Integer
205 Public zDelEntries As Integer
206 Public zUpdate As Integer
207 Public zFreshen As Integer
208 Public zJunkSFX As Integer
209 Public zLatestTime As Integer
210 Public zComment As Integer
211 Public zOffsets As Integer
212 Public zPrivilege As Integer
213 Public zEncryption As Integer
214 Public zRepair As Integer
215 Public zLevel As Integer
216
217 '-- Public Program Variables
218 Public zArgc As Integer ' Number Of Files To Zip Up
219 Public zZipFileName As String ' The Zip File Name ie: Myzip.zip
220 Public zZipFileNames As ZIPnames ' File Names To Zip Up
221 Public zZipInfo As String ' Holds The Zip File Information
222
223 '-- Public Constants
224 '-- For Zip & UnZip Error Codes!
225 Public Const ZE_OK = 0 ' Success (No Error)
226 Public Const ZE_EOF = 2 ' Unexpected End Of Zip File Error
227 Public Const ZE_FORM = 3 ' Zip File Structure Error
228 Public Const ZE_MEM = 4 ' Out Of Memory Error
229 Public Const ZE_LOGIC = 5 ' Internal Logic Error
230 Public Const ZE_BIG = 6 ' Entry Too Large To Split Error
231 Public Const ZE_NOTE = 7 ' Invalid Comment Format Error
232 Public Const ZE_TEST = 8 ' Zip Test (-T) Failed Or Out Of Memory Error
233 Public Const ZE_ABORT = 9 ' User Interrupted Or Termination Error
234 Public Const ZE_TEMP = 10 ' Error Using A Temp File
235 Public Const ZE_READ = 11 ' Read Or Seek Error
236 Public Const ZE_NONE = 12 ' Nothing To Do Error
237 Public Const ZE_NAME = 13 ' Missing Or Empty Zip File Error
238 Public Const ZE_WRITE = 14 ' Error Writing To A File
239 Public Const ZE_CREAT = 15 ' Could't Open To Write Error
240 Public Const ZE_PARMS = 16 ' Bad Command Line Argument Error
241 Public Const ZE_OPEN = 18 ' Could Not Open A Specified File To Read Error
242
243 '-- These Functions Are For The ZIP32.DLL
244 '--
245 '-- Puts A Function Pointer In A Structure
246 '-- For Use With Callbacks...
247 Public Function FnPtr(ByVal lp As Long) As Long
248
249 FnPtr = lp
250
251 End Function
252
253 '-- Callback For ZIP32.DLL - DLL Print Function
254 Public Function ZDLLPrnt(ByRef fname As ZipCBChar, ByVal x As Long) As Long
255
256 Dim s0 As String
257 Dim xx As Long
258
259 '-- Always Put This In Callback Routines!
260 On Error Resume Next
261
262 s0 = ""
263
264 '-- Get Zip32.DLL Message For processing
265 For xx = 0 To x
266 If fname.ch(xx) = 0 Then
267 Exit For
268 Else
269 s0 = s0 + Chr(fname.ch(xx))
270 End If
271 Next
272
273 '----------------------------------------------
274 '-- This Is Where The DLL Passes Back Messages
275 '-- To You! You Can Change The Message Printing
276 '-- Below Here!
277 '----------------------------------------------
278
279 '-- Display Zip File Information
280 '-- zZipInfo = zZipInfo & s0
281 Form1.Print s0;
282
283 DoEvents
284
285 ZDLLPrnt = 0
286
287 End Function
288
289 '-- Callback For ZIP32.DLL - DLL Service Function
290 Public Function ZDLLServ(ByRef mname As ZipCBChar, ByVal x As Long) As Long
291
292 ' x is the size of the file
293
294 Dim s0 As String
295 Dim xx As Long
296
297 '-- Always Put This In Callback Routines!
298 On Error Resume Next
299
300 s0 = ""
301 '-- Get Zip32.DLL Message For processing
302 For xx = 0 To 4096
303 If mname.ch(xx) = 0 Then
304 Exit For
305 Else
306 s0 = s0 + Chr(mname.ch(xx))
307 End If
308 Next
309 ' Form1.Print "-- " & s0 & " - " & x & " bytes"
310
311 ' This is called for each zip entry.
312 ' mname is usually the null terminated file name and x the file size.
313 ' s0 has trimmed file name as VB string.
314
315 ' At this point, s0 contains the message passed from the DLL
316 ' It is up to the developer to code something useful here :)
317 ZDLLServ = 0 ' Setting this to 1 will abort the zip!
318
319 End Function
320
321 '-- Callback For ZIP32.DLL - DLL Password Function
322 Public Function ZDLLPass(ByRef p As ZipCBChar, _
323 ByVal n As Long, ByRef m As ZipCBChar, _
324 ByRef Name As ZipCBChar) As Integer
325
326 Dim prompt As String
327 Dim xx As Integer
328 Dim szpassword As String
329
330 '-- Always Put This In Callback Routines!
331 On Error Resume Next
332
333 ZDLLPass = 1
334
335 '-- If There Is A Password Have The User Enter It!
336 '-- This Can Be Changed
337 szpassword = InputBox("Please Enter The Password!")
338
339 '-- The User Did Not Enter A Password So Exit The Function
340 If szpassword = "" Then Exit Function
341
342 '-- User Entered A Password So Proccess It
343 For xx = 0 To 255
344 If m.ch(xx) = 0 Then
345 Exit For
346 Else
347 prompt = prompt & Chr(m.ch(xx))
348 End If
349 Next
350
351 For xx = 0 To n - 1
352 p.ch(xx) = 0
353 Next
354
355 For xx = 0 To Len(szpassword) - 1
356 p.ch(xx) = Asc(Mid(szpassword, xx + 1, 1))
357 Next
358
359 p.ch(xx) = Chr(0) ' Put Null Terminator For C
360
361 ZDLLPass = 0
362
363 End Function
364
365 '-- Callback For ZIP32.DLL - DLL Comment Function
366 Public Function ZDLLComm(ByRef s1 As ZipCBChar) As Integer
367
368 Dim xx%, szcomment$
369
370 '-- Always Put This In Callback Routines!
371 On Error Resume Next
372
373 ZDLLComm = 1
374 szcomment = InputBox("Enter the comment")
375 If szcomment = "" Then Exit Function
376 For xx = 0 To Len(szcomment) - 1
377 s1.ch(xx) = Asc(Mid$(szcomment, xx + 1, 1))
378 Next xx
379 s1.ch(xx) = Chr(0) ' Put null terminator for C
380
381 End Function
382
383 '-- Main ZIP32.DLL Subroutine.
384 '-- This Is Where It All Happens!!!
385 '--
386 '-- (WARNING!) Do Not Change This Function!!!
387 '--
388 Public Function VBZip32() As Long
389
390 Dim retcode As Long
391
392 On Error Resume Next '-- Nothing Will Go Wrong :-)
393
394 retcode = 0
395
396 '-- Set Address Of ZIP32.DLL Callback Functions
397 '-- (WARNING!) Do Not Change!!!
398 ZUSER.ZDLLPrnt = FnPtr(AddressOf ZDLLPrnt)
399 ZUSER.ZDLLPASSWORD = FnPtr(AddressOf ZDLLPass)
400 ZUSER.ZDLLCOMMENT = FnPtr(AddressOf ZDLLComm)
401 ZUSER.ZDLLSERVICE = FnPtr(AddressOf ZDLLServ)
402
403 '-- Set ZIP32.DLL Callbacks
404 retcode = ZpInit(ZUSER)
405 If retcode = 0 Then
406 MsgBox "Zip32.dll did not initialize. Is it in the current directory " & _
407 "or on the command path?", vbOKOnly, "VB Zip"
408 Exit Function
409 End If
410
411 '-- Setup ZIP32 Options
412 '-- (WARNING!) Do Not Change!
413 ZOPT.Date = zDate ' "12/31/79"? US Date?
414 ZOPT.szRootDir = zRootDir ' Root Directory Pathname
415 ZOPT.szTempDir = zTempDir ' Temp Directory Pathname
416 ZOPT.fSuffix = zSuffix ' Include Suffixes (Not Yet Implemented)
417 ZOPT.fEncrypt = zEncrypt ' 1 If Encryption Wanted
418 ZOPT.fSystem = zSystem ' 1 To Include System/Hidden Files
419 ZOPT.fVolume = zVolume ' 1 If Storing Volume Label
420 ZOPT.fExtra = zExtra ' 1 If Including Extra Attributes
421 ZOPT.fNoDirEntries = zNoDirEntries ' 1 If Ignoring Directory Entries
422 ZOPT.fExcludeDate = zExcludeDate ' 1 If Excluding Files Earlier Than A Specified Date
423 ZOPT.fIncludeDate = zIncludeDate ' 1 If Including Files Earlier Than A Specified Date
424 ZOPT.fVerbose = zVerbose ' 1 If Full Messages Wanted
425 ZOPT.fQuiet = zQuiet ' 1 If Minimum Messages Wanted
426 ZOPT.fCRLF_LF = zCRLF_LF ' 1 If Translate CR/LF To LF
427 ZOPT.fLF_CRLF = zLF_CRLF ' 1 If Translate LF To CR/LF
428 ZOPT.fJunkDir = zJunkDir ' 1 If Junking Directory Names
429 ZOPT.fGrow = zGrow ' 1 If Allow Appending To Zip File
430 ZOPT.fForce = zForce ' 1 If Making Entries Using DOS Names
431 ZOPT.fMove = zMove ' 1 If Deleting Files Added Or Updated
432 ZOPT.fDeleteEntries = zDelEntries ' 1 If Files Passed Have To Be Deleted
433 ZOPT.fUpdate = zUpdate ' 1 If Updating Zip File-Overwrite Only If Newer
434 ZOPT.fFreshen = zFreshen ' 1 If Freshening Zip File-Overwrite Only
435 ZOPT.fJunkSFX = zJunkSFX ' 1 If Junking SFX Prefix
436 ZOPT.fLatestTime = zLatestTime ' 1 If Setting Zip File Time To Time Of Latest File In Archive
437 ZOPT.fComment = zComment ' 1 If Putting Comment In Zip File
438 ZOPT.fOffsets = zOffsets ' 1 If Updating Archive Offsets For SFX Files
439 ZOPT.fPrivilege = zPrivilege ' 1 If Not Saving Privelages
440 ZOPT.fEncryption = zEncryption ' Read Only Property!
441 ZOPT.fRecurse = zRecurse ' 1 or 2 If Recursing Into Subdirectories
442 ZOPT.fRepair = zRepair ' 1 = Fix Archive, 2 = Try Harder To Fix
443 ZOPT.flevel = zLevel ' Compression Level - (0 To 9) Should Be 0!!!
444
445 '-- Set ZIP32.DLL Options
446 retcode = ZpSetOptions(ZOPT)
447
448 '-- Go Zip It Them Up!
449 retcode = ZpArchive(zArgc, zZipFileName, zZipFileNames)
450
451 '-- Return The Function Code
452 VBZip32 = retcode
453
454 End Function
455