"Fossies" - the Fresh Open Source Software Archive 
Member "vb/vbunzip.bas" (25 Jan 2009, 27422 Bytes) of package /windows/misc/unz600dn.zip:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Visual Basic source code syntax highlighting (style:
standard) with prefixed line numbers.
Alternatively you can here
view or
download the uninterpreted source code file.
1 Attribute VB_Name = "VBUnzBas"
2 Option Explicit
3
4 '-- Please Do Not Remove These Comment Lines!
5 '----------------------------------------------------------------
6 '-- Sample VB 5 / VB 6 code to drive unzip32.dll
7 '-- Contributed to the Info-ZIP project by Mike Le Voi
8 '--
9 '-- Contact me at: mlevoi@modemss.brisnet.org.au
10 '--
11 '-- Visit my home page at: http://modemss.brisnet.org.au/~mlevoi
12 '--
13 '-- Use this code at your own risk. Nothing implied or warranted
14 '-- to work on your machine :-)
15 '----------------------------------------------------------------
16 '--
17 '-- This Source Code Is Freely Available From The Info-ZIP Project
18 '-- Web Server At:
19 '-- ftp://ftp.info-zip.org/pub/infozip/infozip.html
20 '--
21 '-- A Very Special Thanks To Mr. Mike Le Voi
22 '-- And Mr. Mike White
23 '-- And The Fine People Of The Info-ZIP Group
24 '-- For Letting Me Use And Modify Their Original
25 '-- Visual Basic 5.0 Code! Thank You Mike Le Voi.
26 '-- For Your Hard Work In Helping Me Get This To Work!!!
27 '---------------------------------------------------------------
28 '--
29 '-- Contributed To The Info-ZIP Project By Raymond L. King.
30 '-- Modified June 21, 1998
31 '-- By Raymond L. King
32 '-- Custom Software Designers
33 '--
34 '-- Contact Me At: king@ntplx.net
35 '-- ICQ 434355
36 '-- Or Visit Our Home Page At: http://www.ntplx.net/~king
37 '--
38 '---------------------------------------------------------------
39 '--
40 '-- Modified August 17, 1998
41 '-- by Christian Spieler
42 '-- (implemented sort of a "real" user interface)
43 '-- Modified May 11, 2003
44 '-- by Christian Spieler
45 '-- (use late binding for referencing the common dialog)
46 '-- Modified February 01, 2008
47 '-- by Christian Spieler
48 '-- (adapted DLL interface changes, fixed UZDLLPass callback)
49 '-- Modified December 08, 2008 to December 30, 2008
50 '-- by Ed Gordon
51 '-- Updated sample project for UnZip 6.0 unzip32.dll
52 '-- (support UnZip 6.0 flags and structures)
53 '-- Modified January 03, 2009
54 '-- by Christian Spieler
55 '-- (better solution for overwrite_all handling, use Double
56 '-- instead of Currency to stay safe against number overflow,
57 '-- corrected UZDLLServ_I32() calling interface,
58 '-- removed code that is unsupported under VB5)
59 '--
60 '---------------------------------------------------------------
61
62 '-- Expected Version data for the DLL compatibility check
63 '
64 ' For consistency of the version checking algorithm, the version number
65 ' constants "UzDLL_MinVer" and "UzDLL_MaxAPI" have to fullfil the
66 ' condition "UzDLL_MinVer <= "UzDLL_MaxAPI".
67 ' Version data supplied by a specific UnZip DLL always obey the
68 ' relation "UzDLL Version" >= "UzDLL API".
69
70 'Oldest UnZip DLL version that is supported by this program
71 Private Const cUzDLL_MinVer_Major As Byte = 6
72 Private Const cUzDLL_MinVer_Minor As Byte = 0
73 Private Const cUzDLL_MinVer_Revis As Byte = 0
74
75 'Last (newest) UnZip DLL API version that is known (and supported)
76 'by this program
77 Private Const cUzDLL_MaxAPI_Major As Byte = 6
78 Private Const cUzDLL_MaxAPI_Minor As Byte = 0
79 Private Const cUzDLL_MaxAPI_Revis As Byte = 0
80
81 'Current structure version ID of the DCLIST structure layout
82 Private Const cUz_DCLStructVer As Long = &H600
83
84 '-- C Style argv
85 Private Type UNZIPnames
86 uzFiles(0 To 99) As String
87 End Type
88
89 '-- Callback Large "String"
90 Private Type UNZIPCBChar
91 ch(32800) As Byte
92 End Type
93
94 '-- Callback Small "String"
95 Private Type UNZIPCBCh
96 ch(256) As Byte
97 End Type
98
99 '-- UNZIP32.DLL DCL Structure
100 Private Type DCLIST
101 StructVersID As Long ' Currently version &H600 of this structure
102 ExtractOnlyNewer As Long ' 1 = Extract Only Newer/New, Else 0
103 SpaceToUnderscore As Long ' 1 = Convert Space To Underscore, Else 0
104 PromptToOverwrite As Long ' 1 = Prompt To Overwrite Required, Else 0
105 fQuiet As Long ' 2 = No Messages, 1 = Less, 0 = All
106 ncflag As Long ' 1 = Write To Stdout, Else 0
107 ntflag As Long ' 1 = Test Zip File, Else 0
108 nvflag As Long ' 0 = Extract, 1 = List Zip Contents
109 nfflag As Long ' 1 = Extract Only Newer Over Existing, Else 0
110 nzflag As Long ' 1 = Display Zip File Comment, Else 0
111 ndflag As Long ' 0 = Junk paths, 1 = safe path components only, 2 = all
112 noflag As Long ' 1 = Overwrite Files, Else 0
113 naflag As Long ' 1 = Convert CR To CRLF, Else 0
114 nZIflag As Long ' 1 = Zip Info Verbose, Else 0
115 B_flag As Long ' 1 = Backup existing files, Else 0
116 C_flag As Long ' 1 = Case Insensitivity, 0 = Case Sensitivity
117 D_flag As Long ' Timestamp restoration, 0 = All, 1 = Files, 2 = None
118 U_flag As Long ' 0 = Unicode enabled, 1 = Escape chars, 2 = No Unicode
119 fPrivilege As Long ' 1 = ACL, 2 = Privileges
120 Zip As String ' The Zip Filename To Extract Files
121 ExtractDir As String ' The Extraction Directory, NULL If Extracting To Current Dir
122 End Type
123
124 '-- UNZIP32.DLL Userfunctions Structure
125 Private Type USERFUNCTION
126 UZDLLPrnt As Long ' Pointer To Apps Print Function
127 UZDLLSND As Long ' Pointer To Apps Sound Function
128 UZDLLREPLACE As Long ' Pointer To Apps Replace Function
129 UZDLLPASSWORD As Long ' Pointer To Apps Password Function
130 ' 64-bit versions (VB6 does not support passing 64-bit values!)
131 UZDLLMESSAGE As Long ' Pointer To Apps Message Function (Not Used!)
132 UZDLLSERVICE As Long ' Pointer To Apps Service Function (Not Used!)
133 ' 32-bit versions
134 UZDLLMESSAGE_I32 As Long ' Pointer To Apps Message Function
135 UZDLLSERVICE_I32 As Long ' Pointer To Apps Service Function
136 ' All 64-bit values passed as low and high parts!
137 TotalSizeComp_Lo As Long ' Total Size Of Zip Archive (low 32 bits)
138 TotalSizeComp_Hi As Long ' Total Size Of Zip Archive (high 32 bits)
139 TotalSize_Lo As Long ' Total Size Of All Files In Archive (low 32)
140 TotalSize_Hi As Long ' Total Size Of All Files In Archive (high 32)
141 NumMembers_Lo As Long ' Total Number Of All Files In The Archive (low 32)
142 NumMembers_Hi As Long ' Total Number Of All Files In The Archive (high 32)
143 CompFactor As Long ' Compression Factor
144 cchComment As Integer ' Flag If Archive Has A Comment!
145 End Type
146
147 '-- UNZIP32.DLL Version Structure
148 Private Type UZPVER2
149 structlen As Long ' Length Of The Structure Being Passed
150 flag As Long ' Bit 0: is_beta bit 1: uses_zlib
151 beta As String * 10 ' e.g., "g BETA" or ""
152 date As String * 20 ' e.g., "4 Sep 95" (beta) or "4 September 1995"
153 zlib As String * 10 ' e.g., "1.0.5" or NULL
154 unzip(1 To 4) As Byte ' Version Type Unzip
155 zipinfo(1 To 4) As Byte ' Version Type Zip Info
156 os2dll As Long ' Version Type OS2 DLL
157 windll(1 To 4) As Byte ' Version Type Windows DLL
158 dllapimin(1 To 4) As Byte ' Version Type DLL API minimum compatibility
159 End Type
160
161 '-- This assumes UNZIP32.DLL is somewhere on your execution path!
162 '-- The term "execution path" means a search in the following locations,
163 '-- in the listed sequence (for more details look up the documentation
164 '-- of the LoadLibrary() Win32 API call):
165 '-- 1) the directory from which the VB6 application was loaded,
166 '-- 2) your current working directory in effect when the VB6 program
167 '-- tries to access a first API call of UNZIP32.DLL,
168 '-- 3) the Windows "SYSTEM32" (only NT/2K/XP...) and "SYSTEM" directories,
169 '-- and the Windows directory,
170 '-- 4) the folder list of your command path (e.g. check the environment
171 '-- variable PATH as set in a console window started from scratch).
172 '-- Normally, the Windows system directory is on your command path,
173 '-- so installing the UNZIP32.DLL in the Windows System Directory
174 '-- should always work.
175 '--
176 '-- WARNING:
177 '-- When a VB6 program is run in the VB6 IDE, the "directory from which the
178 '-- application was loaded" is the
179 '-- ===>>> directory where VB6.EXE is stored (!!!),
180 '-- not the storage directory of the VB project file
181 '-- (the folder returned by "App.Path").
182 '-- When a compiled VB6 program is run, the "application load directory"
183 '-- is identical with the folder reported by "App.Path".
184 '--
185 Private Declare Function Wiz_SingleEntryUnzip Lib "unzip32.dll" _
186 (ByVal ifnc As Long, ByRef ifnv As UNZIPnames, _
187 ByVal xfnc As Long, ByRef xfnv As UNZIPnames, _
188 dcll As DCLIST, Userf As USERFUNCTION) As Long
189
190 Private Declare Function UzpVersion2 Lib "unzip32.dll" _
191 (uzpv As UZPVER2) As Long
192
193 '-- Private variable holding the API version id as reported by the
194 '-- loaded UnZip DLL
195 Private m_UzDllApiVers As Long
196
197 '-- Private Variables For Structure Access
198 Private UZDCL As DCLIST
199 Private UZUSER As USERFUNCTION
200 Private UZVER2 As UZPVER2
201
202 '-- Public Variables For Setting The
203 '-- UNZIP32.DLL DCLIST Structure
204 '-- These Must Be Set Before The Actual Call To VBUnZip32
205 Public uExtractOnlyNewer As Long ' 1 = Extract Only Newer/New, Else 0
206 Public uSpaceUnderScore As Long ' 1 = Convert Space To Underscore, Else 0
207 Public uPromptOverWrite As Long ' 1 = Prompt To Overwrite Required, Else 0
208 Public uQuiet As Long ' 2 = No Messages, 1 = Less, 0 = All
209 Public uWriteStdOut As Long ' 1 = Write To Stdout, Else 0
210 Public uTestZip As Long ' 1 = Test Zip File, Else 0
211 Public uExtractList As Long ' 0 = Extract, 1 = List Contents
212 Public uFreshenExisting As Long ' 1 = Update Existing by Newer, Else 0
213 Public uDisplayComment As Long ' 1 = Display Zip File Comment, Else 0
214 Public uHonorDirectories As Long ' 1 = Honor Directories, Else 0
215 Public uOverWriteFiles As Long ' 1 = Overwrite Files, Else 0
216 Public uConvertCR_CRLF As Long ' 1 = Convert CR To CRLF, Else 0
217 Public uVerbose As Long ' 1 = Zip Info Verbose
218 Public uCaseSensitivity As Long ' 1 = Case Insensitivity, 0 = Case Sensitivity
219 Public uPrivilege As Long ' 1 = ACL, 2 = Privileges, Else 0
220 Public uZipFileName As String ' The Zip File Name
221 Public uExtractDir As String ' Extraction Directory, Null If Current Directory
222
223 '-- Public Program Variables
224 Public uZipNumber As Long ' Zip File Number
225 Public uNumberFiles As Long ' Number Of Files
226 Public uNumberXFiles As Long ' Number Of Extracted Files
227 Public uZipMessage As String ' For Zip Message
228 Public uZipInfo As String ' For Zip Information
229 Public uZipNames As UNZIPnames ' Names Of Files To Unzip
230 Public uExcludeNames As UNZIPnames ' Names Of Zip Files To Exclude
231 Public uVbSkip As Boolean ' For DLL Password Function
232
233 '-- Puts A Function Pointer In A Structure
234 '-- For Callbacks.
235 Public Function FnPtr(ByVal lp As Long) As Long
236
237 FnPtr = lp
238
239 End Function
240
241 '-- Callback For UNZIP32.DLL - Receive Message Function
242 Public Sub UZReceiveDLLMessage_I32( _
243 ByVal ucsize_lo As Long, _
244 ByVal ucsize_hi As Long, _
245 ByVal csiz_lo As Long, _
246 ByVal csiz_hi As Long, _
247 ByVal cfactor As Integer, _
248 ByVal mo As Integer, _
249 ByVal dy As Integer, _
250 ByVal yr As Integer, _
251 ByVal hh As Integer, _
252 ByVal mm As Integer, _
253 ByVal c As Byte, _
254 ByRef fname As UNZIPCBCh, _
255 ByRef meth As UNZIPCBCh, _
256 ByVal crc As Long, _
257 ByVal fCrypt As Byte)
258
259 Dim s0 As String
260 Dim xx As Long
261 Dim cCh As Byte
262 Dim strout As String * 80
263 Dim ucsize As Double
264 Dim csiz As Double
265
266 '-- Always implement a runtime error handler in Callback Routines!
267 On Error Resume Next
268
269 '------------------------------------------------
270 '-- This Is Where The Received Messages Are
271 '-- Printed Out And Displayed.
272 '-- You Can Modify Below!
273 '------------------------------------------------
274
275 strout = Space$(80)
276
277 '-- For Zip Message Printing
278 If uZipNumber = 0 Then
279 Mid$(strout, 1, 50) = "Filename:"
280 Mid$(strout, 53, 4) = "Size"
281 Mid$(strout, 62, 4) = "Date"
282 Mid$(strout, 71, 4) = "Time"
283 uZipMessage = strout & vbNewLine
284 strout = Space$(80)
285 End If
286
287 s0 = ""
288
289 '-- Do Not Change This For Next!!!
290 For xx = 0 To UBound(fname.ch)
291 If fname.ch(xx) = 0 Then Exit For
292 s0 = s0 & Chr$(fname.ch(xx))
293 Next
294
295 ucsize = CnvI64Struct2Dbl(ucsize_lo, ucsize_hi)
296 csiz = CnvI64Struct2Dbl(csiz_lo, csiz_hi)
297
298 '-- Assign Zip Information For Printing
299 Mid$(strout, 1, 50) = Mid$(s0, 1, 50)
300 Mid$(strout, 51, 9) = Right$(" " & CStr(ucsize), 9)
301 Mid$(strout, 62, 3) = Right$("0" & Trim$(CStr(mo)), 2) & "/"
302 Mid$(strout, 65, 3) = Right$("0" & Trim$(CStr(dy)), 2) & "/"
303 Mid$(strout, 68, 2) = Right$("0" & Trim$(CStr(yr)), 2)
304 Mid$(strout, 72, 3) = Right$(Str$(hh), 2) & ":"
305 Mid$(strout, 75, 2) = Right$("0" & Trim$(CStr(mm)), 2)
306
307 ' Mid$(strout, 77, 2) = Right$(" " & CStr(cfactor), 2)
308 ' Mid$(strout, 80, 8) = Right$(" " & CStr(csiz), 8)
309 ' s0 = ""
310 ' For xx = 0 To 255
311 ' If meth.ch(xx) = 0 Then Exit For
312 ' s0 = s0 & Chr$(meth.ch(xx))
313 ' Next xx
314
315 '-- Do Not Modify Below!!!
316 uZipMessage = uZipMessage & strout & vbNewLine
317 uZipNumber = uZipNumber + 1
318
319 End Sub
320
321 '-- Callback For UNZIP32.DLL - Print Message Function
322 Public Function UZDLLPrnt(ByRef fname As UNZIPCBChar, ByVal x As Long) As Long
323
324 Dim s0 As String
325 Dim xx As Long
326 Dim cCh As Byte
327
328 '-- Always implement a runtime error handler in Callback Routines!
329 On Error Resume Next
330
331 s0 = ""
332
333 '-- Gets The UNZIP32.DLL Message For Displaying.
334 For xx = 0 To x - 1
335 cCh = fname.ch(xx)
336 Select Case cCh
337 Case 0
338 Exit For
339 Case 10
340 s0 = s0 & vbNewLine ' Damn UNIX :-)
341 Case 92 ' = Asc("\")
342 s0 = s0 & "/"
343 Case Else
344 s0 = s0 & Chr$(cCh)
345 End Select
346 Next
347
348 '-- Assign Zip Information
349 uZipInfo = uZipInfo & s0
350
351 UZDLLPrnt = 0
352
353 End Function
354
355 '-- Callback For UNZIP32.DLL - DLL Service Function
356 Public Function UZDLLServ_I32(ByRef mname As UNZIPCBChar, _
357 ByVal lUcSiz_Lo As Long, ByVal lUcSiz_Hi As Long) As Long
358
359 Dim UcSiz As Double
360 Dim s0 As String
361 Dim xx As Long
362
363 '-- Always implement a runtime error handler in Callback Routines!
364 On Error Resume Next
365
366 ' Parameters lUcSiz_Lo and lUcSiz_Hi contain the uncompressed size
367 ' of the extracted archive entry.
368 ' This information may be used for some kind of progress display...
369 UcSiz = CnvI64Struct2Dbl(lUcSiz_Lo, lUcSiz_Hi)
370
371 s0 = ""
372 '-- Get Zip32.DLL Message For processing
373 For xx = 0 To UBound(mname.ch)
374 If mname.ch(xx) = 0 Then Exit For
375 s0 = s0 & Chr$(mname.ch(xx))
376 Next
377 ' At this point, s0 contains the message passed from the DLL
378 ' (like the current file being extracted)
379 ' It is up to the developer to code something useful here :)
380
381 UZDLLServ_I32 = 0 ' Setting this to 1 will abort the zip!
382
383 End Function
384
385 '-- Callback For UNZIP32.DLL - Password Function
386 Public Function UZDLLPass(ByRef pwbuf As UNZIPCBCh, _
387 ByVal bufsiz As Long, ByRef promptmsg As UNZIPCBCh, _
388 ByRef entryname As UNZIPCBCh) As Long
389
390 Dim prompt As String
391 Dim xx As Long
392 Dim szpassword As String
393
394 '-- Always implement a runtime error handler in Callback Routines!
395 On Error Resume Next
396
397 UZDLLPass = -1 'IZ_PW_CANCEL
398
399 If uVbSkip Then Exit Function
400
401 '-- Get the Password prompt
402 For xx = 0 To UBound(promptmsg.ch)
403 If promptmsg.ch(xx) = 0 Then Exit For
404 prompt = prompt & Chr$(promptmsg.ch(xx))
405 Next
406 If Len(prompt) = 0 Then
407 prompt = "Please Enter The Password!"
408 Else
409 prompt = prompt & " "
410 For xx = 0 To UBound(entryname.ch)
411 If entryname.ch(xx) = 0 Then Exit For
412 prompt = prompt & Chr$(entryname.ch(xx))
413 Next
414 End If
415
416 '-- Get The Zip File Password
417 Do
418 szpassword = InputBox(prompt)
419 If Len(szpassword) < bufsiz Then Exit Do
420 ' -- Entered password exceeds UnZip's password buffer size
421 If MsgBox("The supplied password exceeds the maximum password length " _
422 & CStr(bufsiz - 1) & " supported by the UnZip DLL." _
423 , vbExclamation + vbRetryCancel, "UnZip password too long") _
424 = vbCancel Then
425 szpassword = ""
426 Exit Do
427 End If
428 Loop
429
430 '-- No Password So Exit The Function
431 If Len(szpassword) = 0 Then
432 uVbSkip = True
433 Exit Function
434 End If
435
436 '-- Zip File Password So Process It
437 For xx = 0 To bufsiz - 1
438 pwbuf.ch(xx) = 0
439 Next
440 '-- Password length has already been checked, so
441 '-- it will fit into the communication buffer.
442 For xx = 0 To Len(szpassword) - 1
443 pwbuf.ch(xx) = Asc(Mid$(szpassword, xx + 1, 1))
444 Next
445
446 pwbuf.ch(xx) = 0 ' Put Null Terminator For C
447
448 UZDLLPass = 0 ' IZ_PW_ENTERED
449
450 End Function
451
452 '-- Callback For UNZIP32.DLL - Report Function To Overwrite Files.
453 '-- This Function Will Display A MsgBox Asking The User
454 '-- If They Would Like To Overwrite The Files.
455 Public Function UZDLLReplacePrmt(ByRef fname As UNZIPCBChar, _
456 ByVal fnbufsiz As Long) As Long
457
458 Dim s0 As String
459 Dim xx As Long
460 Dim cCh As Byte
461 Dim bufmax As Long
462
463 '-- Always implement a runtime error handler in Callback Routines!
464 On Error Resume Next
465
466 UZDLLReplacePrmt = 100 ' 100 = Do Not Overwrite - Keep Asking User
467 s0 = ""
468 bufmax = UBound(fname.ch)
469 If bufmax >= fnbufsiz Then bufmax = fnbufsiz - 1
470
471 For xx = 0 To bufmax
472 cCh = fname.ch(xx)
473 Select Case cCh
474 Case 0
475 Exit For
476 Case 92 ' = Asc("\")
477 s0 = s0 & "/"
478 Case Else
479 s0 = s0 & Chr$(cCh)
480 End Select
481 Next
482
483 '-- This Is The MsgBox Code
484 xx = MsgBox("Overwrite """ & s0 & """ ?", vbExclamation Or vbYesNoCancel, _
485 "VBUnZip32 - File Already Exists!")
486 Select Case xx
487 Case vbYes
488 UZDLLReplacePrmt = 102 ' 102 = Overwrite, 103 = Overwrite All
489 Case vbCancel
490 UZDLLReplacePrmt = 104 ' 104 = Overwrite None
491 Case Else
492 'keep the default as set at function entry.
493 End Select
494
495 End Function
496
497 '-- ASCIIZ To String Function
498 Public Function szTrim(szString As String) As String
499
500 Dim pos As Long
501
502 pos = InStr(szString, vbNullChar)
503
504 Select Case pos
505 Case Is > 1
506 szTrim = Trim$(Left$(szString, pos - 1))
507 Case 1
508 szTrim = ""
509 Case Else
510 szTrim = Trim$(szString)
511 End Select
512
513 End Function
514
515 '-- convert a 64-bit int divided in two Int32 variables into
516 '-- a single 64-bit floating-point value
517 Private Function CnvI64Struct2Dbl(ByVal lInt64Lo As Long, lInt64Hi As Long) As Double
518 If lInt64Lo < 0 Then
519 CnvI64Struct2Dbl = 2# ^ 32 + CDbl(lInt64Lo)
520 Else
521 CnvI64Struct2Dbl = CDbl(lInt64Lo)
522 End If
523 CnvI64Struct2Dbl = CnvI64Struct2Dbl + (2# ^ 32) * CDbl(lInt64Hi)
524 End Function
525
526 '-- Concatenate a "structured" version number into a single integer value,
527 '-- to facilitate version number comparisons
528 '-- (In case the practically used NumMajor numbers will ever exceed 128, it
529 '-- should be considered to use the number type "Double" to store the
530 '-- concatenated number. "Double" can store signed integer numbers up to a
531 '-- width of 52 bits without loss of precision.)
532 Private Function ConcatVersNums(ByVal NumMajor As Byte, ByVal NumMinor As Byte _
533 , ByVal NumRevis As Byte, ByVal NumBuild As Byte) As Long
534 If (NumMajor And &H80) <> 0 Then
535 ConcatVersNums = (NumMajor And &H7F) * (2 ^ 24) Or &H80000000
536 Else
537 ConcatVersNums = NumMajor * (2 ^ 24)
538 End If
539 ConcatVersNums = ConcatVersNums _
540 + NumMinor * (2 ^ 16) _
541 + NumRevis * (2 ^ 8) _
542 + NumBuild
543 End Function
544
545 '-- Helper function to provide a printable version number string, using the
546 '-- current formatting rule for version number display as implemented in UnZip.
547 Private Function VersNumsToTxt(ByVal NumMajor As Byte, ByVal NumMinor As Byte _
548 , ByVal NumRevis As Byte) As String
549 VersNumsToTxt = CStr(NumMajor) & "." & Hex$(NumMinor)
550 If NumRevis <> 0 Then VersNumsToTxt = VersNumsToTxt & Hex$(NumRevis)
551 End Function
552
553 '-- Helper function to convert a "concatenated" version id into a printable
554 '-- version number string, using the current formatting rule for version number
555 '-- display as implemented in UnZip.
556 Private Function VersIDToTxt(ByVal VersionID As Long) As String
557 Dim lNumTemp As Long
558
559 lNumTemp = VersionID \ (2 ^ 24)
560 If lNumTemp < 0 Then lNumTemp = 256 + lNumTemp
561 VersIDToTxt = CStr(lNumTemp) & "." _
562 & Hex$((VersionID And &HFF0000) \ &H10000)
563 lNumTemp = (VersionID And &HFF00&) \ &H100
564 If lNumTemp <> 0 Then VersIDToTxt = VersIDToTxt & Hex$(lNumTemp)
565 End Function
566
567 '-- Main UNZIP32.DLL UnZip32 Subroutine
568 '-- (WARNING!) Do Not Change!
569 Public Sub VBUnZip32()
570
571 Dim retcode As Long
572 Dim MsgStr As String
573 Dim TotalSizeComp As Double
574 Dim TotalSize As Double
575 Dim NumMembers As Double
576
577 '-- Set The UNZIP32.DLL Options
578 '-- (WARNING!) Do Not Change
579 UZDCL.StructVersID = cUz_DCLStructVer ' Current version of this structure
580 UZDCL.ExtractOnlyNewer = uExtractOnlyNewer ' 1 = Extract Only Newer/New
581 UZDCL.SpaceToUnderscore = uSpaceUnderScore ' 1 = Convert Space To Underscore
582 UZDCL.PromptToOverwrite = uPromptOverWrite ' 1 = Prompt To Overwrite Required
583 UZDCL.fQuiet = uQuiet ' 2 = No Messages 1 = Less 0 = All
584 UZDCL.ncflag = uWriteStdOut ' 1 = Write To Stdout
585 UZDCL.ntflag = uTestZip ' 1 = Test Zip File
586 UZDCL.nvflag = uExtractList ' 0 = Extract 1 = List Contents
587 UZDCL.nfflag = uFreshenExisting ' 1 = Update Existing by Newer
588 UZDCL.nzflag = uDisplayComment ' 1 = Display Zip File Comment
589 UZDCL.ndflag = uHonorDirectories ' 1 = Honour Directories
590 UZDCL.noflag = uOverWriteFiles ' 1 = Overwrite Files
591 UZDCL.naflag = uConvertCR_CRLF ' 1 = Convert CR To CRLF
592 UZDCL.nZIflag = uVerbose ' 1 = Zip Info Verbose
593 UZDCL.C_flag = uCaseSensitivity ' 1 = Case insensitivity, 0 = Case Sensitivity
594 UZDCL.fPrivilege = uPrivilege ' 1 = ACL 2 = Priv
595 UZDCL.Zip = uZipFileName ' ZIP Filename
596 UZDCL.ExtractDir = uExtractDir ' Extraction Directory, NULL If Extracting
597 ' To Current Directory
598
599 '-- Set Callback Addresses
600 '-- (WARNING!!!) Do Not Change
601 UZUSER.UZDLLPrnt = FnPtr(AddressOf UZDLLPrnt)
602 UZUSER.UZDLLSND = 0& '-- Not Supported
603 UZUSER.UZDLLREPLACE = FnPtr(AddressOf UZDLLReplacePrmt)
604 UZUSER.UZDLLPASSWORD = FnPtr(AddressOf UZDLLPass)
605 UZUSER.UZDLLMESSAGE_I32 = FnPtr(AddressOf UZReceiveDLLMessage_I32)
606 UZUSER.UZDLLSERVICE_I32 = FnPtr(AddressOf UZDLLServ_I32)
607
608 '-- Set UNZIP32.DLL Version Space
609 '-- (WARNING!!!) Do Not Change
610 With UZVER2
611 .structlen = Len(UZVER2)
612 .beta = String$(10, vbNullChar)
613 .date = String$(20, vbNullChar)
614 .zlib = String$(10, vbNullChar)
615 End With
616
617 '-- Get Version
618 retcode = UzpVersion2(UZVER2)
619 If retcode <> 0 Then
620 MsgBox "Incompatible DLL version discovered!" & vbNewLine _
621 & "The UnZip DLL requires a version structure of length " _
622 & CStr(retcode) & ", but the VB frontend expects the DLL to need " _
623 & Len(UZVER2) & "bytes." & vbNewLine _
624 & vbNewLine & "The program cannot continue." _
625 , vbCritical + vbOKOnly, App.Title
626 Exit Sub
627 End If
628
629 ' Check that the DLL version is sufficiently recent
630 If (ConcatVersNums(UZVER2.unzip(1), UZVER2.unzip(2) _
631 , UZVER2.unzip(3), UZVER2.unzip(4)) < _
632 ConcatVersNums(cUzDLL_MinVer_Major, cUzDLL_MinVer_Minor _
633 , cUzDLL_MinVer_Revis, 0)) Then
634 ' The found UnZip DLL is too old!
635 MsgBox "Incompatible old DLL version discovered!" & vbNewLine _
636 & "This program requires an UnZip DLL version of at least " _
637 & VersNumsToTxt(cUzDLL_MinVer_Major, cUzDLL_MinVer_Minor, cUzDLL_MinVer_Revis) _
638 & ", but the version reported by the found DLL is only " _
639 & VersNumsToTxt(UZVER2.unzip(1), UZVER2.unzip(2), UZVER2.unzip(3)) _
640 & "." & vbNewLine _
641 & vbNewLine & "The program cannot continue." _
642 , vbCritical + vbOKOnly, App.Title
643 Exit Sub
644 End If
645
646 ' Concatenate the DLL API version info into a single version id variable.
647 ' This variable may be used later on to switch between different
648 ' known variants of specific API calls or API structures.
649 m_UzDllApiVers = ConcatVersNums(UZVER2.dllapimin(1), UZVER2.dllapimin(2) _
650 , UZVER2.dllapimin(3), UZVER2.dllapimin(4))
651 ' check that the DLL API version is not too new
652 If (m_UzDllApiVers > _
653 ConcatVersNums(cUzDLL_MaxAPI_Major, cUzDLL_MaxAPI_Minor _
654 , cUzDLL_MaxAPI_Revis, 0)) Then
655 ' The found UnZip DLL is too new!
656 MsgBox "DLL version with incompatible API discovered!" & vbNewLine _
657 & "This program can only handle UnZip DLL API versions up to " _
658 & VersNumsToTxt(cUzDLL_MaxAPI_Major, cUzDLL_MaxAPI_Minor, cUzDLL_MaxAPI_Revis) _
659 & ", but the found DLL reports a newer API version of " _
660 & VersIDToTxt(m_UzDllApiVers) & "." & vbNewLine _
661 & vbNewLine & "The program cannot continue." _
662 , vbCritical + vbOKOnly, App.Title
663 Exit Sub
664 End If
665
666 '--------------------------------------
667 '-- You Can Change This For Displaying
668 '-- The Version Information!
669 '--------------------------------------
670 MsgStr$ = "DLL Date: " & szTrim(UZVER2.date)
671 MsgStr$ = MsgStr$ & vbNewLine$ & "Zip Info: " _
672 & VersNumsToTxt(UZVER2.zipinfo(1), UZVER2.zipinfo(2), UZVER2.zipinfo(3))
673 MsgStr$ = MsgStr$ & vbNewLine$ & "DLL Version: " _
674 & VersNumsToTxt(UZVER2.windll(1), UZVER2.windll(2), UZVER2.windll(3))
675 MsgStr$ = MsgStr$ & vbNewLine$ & "DLL API Compatibility: " _
676 & VersIDToTxt(m_UzDllApiVers)
677 MsgStr$ = MsgStr$ & vbNewLine$ & "--------------"
678 '-- End Of Version Information.
679
680 '-- Go UnZip The Files! (Do Not Change Below!!!)
681 '-- This Is The Actual UnZip Routine
682 retcode = Wiz_SingleEntryUnzip(uNumberFiles, uZipNames, uNumberXFiles, _
683 uExcludeNames, UZDCL, UZUSER)
684 '---------------------------------------------------------------
685
686 '-- If There Is An Error Display A MsgBox!
687 If retcode <> 0 Then _
688 MsgBox "UnZip DLL call returned error code #" & CStr(retcode) _
689 , vbExclamation, App.Title
690
691 '-- Add up 64-bit values
692 TotalSizeComp = CnvI64Struct2Dbl(UZUSER.TotalSizeComp_Lo, _
693 UZUSER.TotalSizeComp_Hi)
694 TotalSize = CnvI64Struct2Dbl(UZUSER.TotalSize_Lo, _
695 UZUSER.TotalSize_Hi)
696 NumMembers = CnvI64Struct2Dbl(UZUSER.NumMembers_Lo, _
697 UZUSER.NumMembers_Hi)
698
699 '-- You Can Change This As Needed!
700 '-- For Compression Information
701 MsgStr$ = MsgStr$ & vbNewLine & _
702 "Only Shows If uExtractList = 1 List Contents"
703 MsgStr$ = MsgStr$ & vbNewLine & "--------------"
704 MsgStr$ = MsgStr$ & vbNewLine & "Comment : " & UZUSER.cchComment
705 MsgStr$ = MsgStr$ & vbNewLine & "Total Size Comp : " _
706 & Format$(TotalSizeComp, "#,0")
707 MsgStr$ = MsgStr$ & vbNewLine & "Total Size : " _
708 & Format$(TotalSize, "#,0")
709 MsgStr$ = MsgStr$ & vbNewLine & "Compress Factor : %" & UZUSER.CompFactor
710 MsgStr$ = MsgStr$ & vbNewLine & "Num Of Members : " & NumMembers
711 MsgStr$ = MsgStr$ & vbNewLine & "--------------"
712
713 VBUnzFrm.txtMsgOut.Text = VBUnzFrm.txtMsgOut.Text & MsgStr$ & vbNewLine
714 End Sub