1Attribute VB_Name = "VBUnzBas" 2Option 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 71Private Const cUzDLL_MinVer_Major As Byte = 6 72Private Const cUzDLL_MinVer_Minor As Byte = 0 73Private Const cUzDLL_MinVer_Revis As Byte = 0 74 75'Last (newest) UnZip DLL API version that is known (and supported) 76'by this program 77Private Const cUzDLL_MaxAPI_Major As Byte = 6 78Private Const cUzDLL_MaxAPI_Minor As Byte = 0 79Private Const cUzDLL_MaxAPI_Revis As Byte = 0 80 81'Current structure version ID of the DCLIST structure layout 82Private Const cUz_DCLStructVer As Long = &H600 83 84'-- C Style argv 85Private Type UNZIPnames 86 uzFiles(0 To 99) As String 87End Type 88 89'-- Callback Large "String" 90Private Type UNZIPCBChar 91 ch(32800) As Byte 92End Type 93 94'-- Callback Small "String" 95Private Type UNZIPCBCh 96 ch(256) As Byte 97End Type 98 99'-- UNZIP32.DLL DCL Structure 100Private 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 122End Type 123 124'-- UNZIP32.DLL Userfunctions Structure 125Private 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! 145End Type 146 147'-- UNZIP32.DLL Version Structure 148Private 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 159End 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'-- 185Private 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 190Private 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 195Private m_UzDllApiVers As Long 196 197'-- Private Variables For Structure Access 198Private UZDCL As DCLIST 199Private UZUSER As USERFUNCTION 200Private 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 205Public uExtractOnlyNewer As Long ' 1 = Extract Only Newer/New, Else 0 206Public uSpaceUnderScore As Long ' 1 = Convert Space To Underscore, Else 0 207Public uPromptOverWrite As Long ' 1 = Prompt To Overwrite Required, Else 0 208Public uQuiet As Long ' 2 = No Messages, 1 = Less, 0 = All 209Public uWriteStdOut As Long ' 1 = Write To Stdout, Else 0 210Public uTestZip As Long ' 1 = Test Zip File, Else 0 211Public uExtractList As Long ' 0 = Extract, 1 = List Contents 212Public uFreshenExisting As Long ' 1 = Update Existing by Newer, Else 0 213Public uDisplayComment As Long ' 1 = Display Zip File Comment, Else 0 214Public uHonorDirectories As Long ' 1 = Honor Directories, Else 0 215Public uOverWriteFiles As Long ' 1 = Overwrite Files, Else 0 216Public uConvertCR_CRLF As Long ' 1 = Convert CR To CRLF, Else 0 217Public uVerbose As Long ' 1 = Zip Info Verbose 218Public uCaseSensitivity As Long ' 1 = Case Insensitivity, 0 = Case Sensitivity 219Public uPrivilege As Long ' 1 = ACL, 2 = Privileges, Else 0 220Public uZipFileName As String ' The Zip File Name 221Public uExtractDir As String ' Extraction Directory, Null If Current Directory 222 223'-- Public Program Variables 224Public uZipNumber As Long ' Zip File Number 225Public uNumberFiles As Long ' Number Of Files 226Public uNumberXFiles As Long ' Number Of Extracted Files 227Public uZipMessage As String ' For Zip Message 228Public uZipInfo As String ' For Zip Information 229Public uZipNames As UNZIPnames ' Names Of Files To Unzip 230Public uExcludeNames As UNZIPnames ' Names Of Zip Files To Exclude 231Public uVbSkip As Boolean ' For DLL Password Function 232 233'-- Puts A Function Pointer In A Structure 234'-- For Callbacks. 235Public Function FnPtr(ByVal lp As Long) As Long 236 237 FnPtr = lp 238 239End Function 240 241'-- Callback For UNZIP32.DLL - Receive Message Function 242Public 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 319End Sub 320 321'-- Callback For UNZIP32.DLL - Print Message Function 322Public 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 353End Function 354 355'-- Callback For UNZIP32.DLL - DLL Service Function 356Public 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 383End Function 384 385'-- Callback For UNZIP32.DLL - Password Function 386Public 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 450End 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. 455Public 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 495End Function 496 497'-- ASCIIZ To String Function 498Public 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 513End Function 514 515'-- convert a 64-bit int divided in two Int32 variables into 516'-- a single 64-bit floating-point value 517Private 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) 524End 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.) 532Private 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 543End 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. 547Private 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) 551End 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. 556Private 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) 565End Function 566 567'-- Main UNZIP32.DLL UnZip32 Subroutine 568'-- (WARNING!) Do Not Change! 569Public 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 714End Sub 715