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