diff options
Diffstat (limited to 'windll/VBz64/VBZipBas.bas')
| -rw-r--r-- | windll/VBz64/VBZipBas.bas | 737 |
1 files changed, 737 insertions, 0 deletions
diff --git a/windll/VBz64/VBZipBas.bas b/windll/VBz64/VBZipBas.bas new file mode 100644 index 0000000..99547a0 --- /dev/null +++ b/windll/VBz64/VBZipBas.bas @@ -0,0 +1,737 @@ +Attribute VB_Name = "VBZipBas" + +Option Explicit + +'--------------------------------------------------------------- +'-- Please Do Not Remove These Comments!!! +'--------------------------------------------------------------- +'-- Sample VB 6 code to drive zip32z64.dll +'-- Based on the code contributed to the Info-ZIP project +'-- by Mike Le Voi +'-- +'-- See the original VB example in a separate directory for +'-- more information +'-- +'-- Use this code at your own risk. Nothing implied or warranted +'-- to work on your machine :-) +'--------------------------------------------------------------- +'-- +'-- The Source Code Is Freely Available From Info-ZIP At: +'-- ftp://ftp.info-zip.org/pub/infozip/infozip.html +'-- +'-- A Very Special Thanks To Mr. Mike Le Voi +'-- And Mr. Mike White Of The Info-ZIP +'-- For Letting Me Use And Modify His Orginal +'-- Visual Basic 5.0 Code! Thank You Mike Le Voi. +'--------------------------------------------------------------- + +'--------------------------------------------------------------- +' This example is redesigned to work with Zip32z64.dll compiled from +' Zip 3.0 with Zip64 enabled. This allows for archives with more +' and larger files than allowed in previous versions. +' +' Modified 4/24/2004, 12/4/2007 by Ed Gordon +'--------------------------------------------------------------- + +'--------------------------------------------------------------- +' Usage notes: +' +' This code uses Zip32z64.dll. You DO NOT need to register the +' DLL to use it. You also DO NOT need to reference it in your +' VB project. You DO have to copy the DLL to your SYSTEM +' directory, your VB project directory, or place it in a directory +' on your command PATH. +' +' Note that Zip32z64 is probably not thread safe so you should avoid +' using the dll in multiple threads at the same time without first +' testing for interaction. +' +' All code provided under the Info-Zip license. If you have +' any questions please contact Info-Zip. +' +' April 24 2004 EG +' +'--------------------------------------------------------------- + +'-- C Style argv +'-- Holds The Zip Archive Filenames +' +' Max for zFiles just over 8000 as each pointer takes up 4 bytes and +' VB only allows 32 kB of local variables and that includes function +' parameters. - 3/19/2004 EG +' +' Can put names in strZipFileNames instead of using this array, +' which avoids this limit. File names are separated by spaces. +' Enclose names in quotes if include spaces. +Public Type ZIPnames + zFiles(1 To 100) As String +End Type + +'-- Call Back "String" +Public Type ZipCBChar + ch(4096) As Byte +End Type + +'-- Version Structure +Public Type VerType + Major As Byte + Minor As Byte + PatchLevel As Byte + NotUsed As Byte +End Type +Public Type ZipVerType + structlen As Long ' Length Of The Structure Being Passed + flag As Long ' Bit 0: is_beta bit 1: uses_zlib + Beta As String * 10 ' e.g., "g BETA" or "" + date As String * 20 ' e.g., "4 Sep 95" (beta) or "4 September 1995" + ZLIB As String * 10 ' e.g., "1.0.5" or NULL + encryption As Long ' 0 if encryption not available + ZipVersion As VerType + os2dllVersion As VerType + windllVersion As VerType +End Type + +'-- ZPOPT Is Used To Set The Options In The ZIP32z64.DLL +Public Type ZpOpt + date As String ' Date in either US 12/31/98 or 1998-12-31 format + szRootDir As String ' Root Directory Pathname (Up To 256 Bytes Long) + szTempDir As String ' Temp Directory Pathname (Up To 256 Bytes Long) + fTemp As Long ' 1 If Temp dir Wanted, Else 0 + fSuffix As Long ' Include Suffixes (Not Yet Implemented!) + fEncrypt As Long ' 1 If Encryption Wanted, Else 0 + fSystem As Long ' 1 To Include System/Hidden Files, Else 0 + fVolume As Long ' 1 If Storing Volume Label, Else 0 + fExtra As Long ' 1 If Excluding Extra Attributes, Else 0 + fNoDirEntries As Long ' 1 If Ignoring Directory Entries (end with /), Else 0 + fExcludeDate As Long ' 1 If Excluding Files After Specified Date, Else 0 + fIncludeDate As Long ' 1 If Including Files After Specified Date, Else 0 + fVerbose As Long ' 1 If Full Messages Wanted, Else 0 + fQuiet As Long ' 1 If Minimum Messages Wanted, Else 0 + fCRLF_LF As Long ' 1 If Translate CR/LF To LF, Else 0 + fLF_CRLF As Long ' 1 If Translate LF To CR/LF, Else 0 + fJunkDir As Long ' 1 If Junking Directory Names on entries, Else 0 + fGrow As Long ' 1 If Allow Appending To Zip File, Else 0 + fForce As Long ' 1 If Making Entries Using DOS File Names, Else 0 + fMove As Long ' 1 If Deleting Files Added Or Updated, Else 0 + fDeleteEntries As Long ' 1 If Files Passed Have To Be Deleted, Else 0 + fUpdate As Long ' 1 If Updating Zip File-Overwrite Only If Newer, Else 0 + fFreshen As Long ' 1 If Freshing Zip File-Overwrite Only, Else 0 + fJunkSFX As Long ' 1 If Junking SFX Prefix, Else 0 + fLatestTime As Long ' 1 If Setting Zip File Time To Time Of Latest File In Archive, Else 0 + fComment As Long ' 1 If Putting Comment In Zip File, Else 0 + fOffsets As Long ' 1 If Updating Archive Offsets For SFX Files, Else 0 + fPrivilege As Long ' 1 If Not Saving Privileges, Else 0 + fEncryption As Long ' Read Only Property!!! + szSplitSize As String ' Size of split if splitting, Else NULL (empty string) + ' This string contains the size that you want to + ' split the archive into. i.e. 100 for 100 bytes, + ' 2K for 2 k bytes, where K is 1024, m for meg + ' and g for gig. + szIncludeList As String ' If used, space separated list of Include filename + ' patterns where match includes file - put quotes + ' around each filename pattern. + IncludeListCount As Long ' place filler (not for VB) - (inits to 0) DO NOT USE + IncludeList As Long ' place filler (not for VB) - (inits to 0) DO NOT USE + szExcludeList As String ' If used, space separated list of Exclude filename + ' patterns where match excludes file - put quotes + ' around each filename pattern. + ExcludeListCount As Long ' place filler (not for VB) - (inits to 0) DO NOT USE + ExcludeList As Long ' place filler (not for VB) - (inits to 0) DO NOT USE + fRecurse As Long ' 1 (-r), 2 (-R) If Recursing Into Sub-Directories, Else 0 + fRepair As Long ' 1 = Fix Archive, 2 = Try Harder To Fix, Else 0 + flevel As Byte ' Compression Level - 0 = Stored 6 = Default 9 = Max +End Type + + +' Used by SetZipOptions +Public Enum ZipModeType + Add = 0 + Delete = 1 + Update = 2 + Freshen = 3 +End Enum +Public Enum CompressionLevelType + c0_NoCompression = 0 + c1_Fast = 1 + c2_Fast = 2 + c3_Fast = 3 + c4_Med = 4 + c5_Med = 5 + c6_Default = 6 + c7_Extra = 7 + c8_Extra = 8 + c9_Max = 9 +End Enum +Public Enum Translate_LF_Type + No_Line_End_Trans = 0 + LF_To_CRLF = 1 + CRLF_To_LF = 2 +End Enum +Public Enum RepairType + NoRepair = 0 + TryFix = 1 + TryFixHarder = 2 +End Enum +Public Enum VerbosenessType + Quiet = 0 + Normal = 1 + Verbose = 2 +End Enum +Public Enum RecurseType + NoRecurse = 0 + r_RecurseIntoSubdirectories = 1 + R_RecurseUsingPatterns = 2 +End Enum + + +'-- This Structure Is Used For The ZIP32z64.DLL Function Callbacks +' Assumes Zip32z64.dll with Zip64 enabled +Public Type ZIPUSERFUNCTIONS + ZDLLPrnt As Long ' Callback ZIP32z64.DLL Print Function + ZDLLCOMMENT As Long ' Callback ZIP32z64.DLL Comment Function + ZDLLPASSWORD As Long ' Callback ZIP32z64.DLL Password Function + ZDLLSPLIT As Long ' Callback ZIP32z64.DLL Split Select Function + ' There are 2 versions of SERVICE, we use one does not need 64-bit data type + ZDLLSERVICE As Long ' Callback ZIP32z64.DLL Service Function + ZDLLSERVICE_NO_INT64 As Long ' Callback ZIP32z64.DLL Service Function +End Type + +'-- Default encryption password (used in callback if not empty string) +Public EncryptionPassword As String + +'-- For setting the archive comment +Public ArchiveCommentText + +'-- version info +Public ZipVersion As ZipVerType + +'-- Local Declarations +Public ZOPT As ZpOpt +Public ZUSER As ZIPUSERFUNCTIONS + +'-- This Assumes ZIP32z64.DLL Is In Your \windows\system directory +'-- or a copy is in the program directory or in some other directory +'-- listed in PATH +Private Declare Function ZpInit Lib "zip32z64.dll" _ + (ByRef Zipfun As ZIPUSERFUNCTIONS) As Long '-- Set Zip Callbacks + +Private Declare Function ZpArchive Lib "zip32z64.dll" _ + (ByVal argc As Long, ByVal funame As String, _ + ByRef argv As ZIPnames, ByVal strNames As String, ByRef Opts As ZpOpt) As Long '-- Real Zipping Action + +Private Declare Sub ZpVersion Lib "zip32z64.dll" _ + (ByRef ZipVersion As ZipVerType) '-- Version of DLL + + +'------------------------------------------------------- +'-- Public Variables For Setting The ZPOPT Structure... +'-- (WARNING!!!) You Must Set The Options That You +'-- Want The ZIP32.DLL To Do! +'-- Before Calling VBZip32! +'-- +'-- NOTE: See The Above ZPOPT Structure Or The VBZip32 +'-- Function, For The Meaning Of These Variables +'-- And How To Use And Set Them!!! +'-- These Parameters Must Be Set Before The Actual Call +'-- To The VBZip32 Function! +'------------------------------------------------------- + +'-- Public Program Variables +Public zArgc As Integer ' Number Of Files To Zip Up +Public zZipArchiveName As String ' The Zip File Name ie: Myzip.zip +Public zZipFileNames As ZIPnames ' File Names To Zip Up +Public strZipFileNames As String ' String of names to Zip Up +Public zZipInfo As String ' Holds The Zip File Information + +'-- Public Constants +'-- For Zip & UnZip Error Codes! +Public Const ZE_OK = 0 ' Success (No Error) +Public Const ZE_EOF = 2 ' Unexpected End Of Zip File Error +Public Const ZE_FORM = 3 ' Zip File Structure Error +Public Const ZE_MEM = 4 ' Out Of Memory Error +Public Const ZE_LOGIC = 5 ' Internal Logic Error +Public Const ZE_BIG = 6 ' Entry Too Large To Split Error +Public Const ZE_NOTE = 7 ' Invalid Comment Format Error +Public Const ZE_TEST = 8 ' Zip Test (-T) Failed Or Out Of Memory Error +Public Const ZE_ABORT = 9 ' User Interrupted Or Termination Error +Public Const ZE_TEMP = 10 ' Error Using A Temp File +Public Const ZE_READ = 11 ' Read Or Seek Error +Public Const ZE_NONE = 12 ' Nothing To Do Error +Public Const ZE_NAME = 13 ' Missing Or Empty Zip File Error +Public Const ZE_WRITE = 14 ' Error Writing To A File +Public Const ZE_CREAT = 15 ' Could't Open To Write Error +Public Const ZE_PARMS = 16 ' Bad Command Line Argument Error +Public Const ZE_OPEN = 18 ' Could Not Open A Specified File To Read Error + +'-- These Functions Are For The ZIP32z64.DLL +'-- +'-- Puts A Function Pointer In A Structure +'-- For Use With Callbacks... +Public Function FnPtr(ByVal lp As Long) As Long + + FnPtr = lp + +End Function + +'-- Callback For ZIP32z64.DLL - DLL Print Function +Public Function ZDLLPrnt(ByRef fname As ZipCBChar, ByVal x As Long) As Long + + Dim s0 As String + Dim xx As Long + + '-- Always Put This In Callback Routines! + On Error Resume Next + + s0 = "" + + '-- Get Zip32.DLL Message For processing + For xx = 0 To x + If fname.ch(xx) = 0 Then + Exit For + Else + s0 = s0 + Chr(fname.ch(xx)) + End If + Next + + '---------------------------------------------- + '-- This Is Where The DLL Passes Back Messages + '-- To You! You Can Change The Message Printing + '-- Below Here! + '---------------------------------------------- + + '-- Display Zip File Information + '-- zZipInfo = zZipInfo & s0 + Form1.Print s0; + + DoEvents + + ZDLLPrnt = 0 + +End Function + +'-- Callback For ZIP32z64.DLL - DLL Service Function +Public Function ZDLLServ(ByRef mname As ZipCBChar, _ + ByVal LowSize As Long, _ + ByVal HighSize As Long) As Long + + Dim s0 As String + Dim xx As Long + Dim FS As Currency ' for large file sizes + + '-- Always Put This In Callback Routines! + On Error Resume Next + + FS = (HighSize * &H10000 * &H10000) + LowSize + ' Form1.Print "ZDLLServ returned File Size High " & HighSize & _ + ' " Low " & LowSize & " = " & FS & " bytes" + + s0 = "" + '-- Get Zip32.DLL Message For processing + For xx = 0 To 4096 ' x + If mname.ch(xx) = 0 Then + Exit For + Else + s0 = s0 + Chr(mname.ch(xx)) + End If + Next + ' At this point, s0 contains the message passed from the DLL + ' It is up to the developer to code something useful here :) + ZDLLServ = 0 ' Setting this to 1 will abort the zip! + +End Function + +'-- Callback For ZIP32z64.DLL - DLL Password Function +Public Function ZDLLPass(ByRef p As ZipCBChar, _ + ByVal n As Long, ByRef m As ZipCBChar, _ + ByRef Name As ZipCBChar) As Integer + + Dim filename As String + Dim prompt As String + Dim xx As Integer + Dim szpassword As String + + '-- Always Put This In Callback Routines! + On Error Resume Next + + ZDLLPass = 1 + + '-- User Entered A Password So Proccess It + + '-- Enter or Verify + For xx = 0 To 255 + If m.ch(xx) = 0 Then + Exit For + Else + prompt = prompt & Chr(m.ch(xx)) + End If + Next + + '-- If There Is A Password Have The User Enter It! + '-- This Can Be Changed + + '-- Now skip asking if default password set + If EncryptionPassword <> "" Then + szpassword = EncryptionPassword + Else + szpassword = InputBox("Please Enter The Password!", prompt) + End If + + '-- The User Did Not Enter A Password So Exit The Function + If szpassword = "" Then Exit Function + + For xx = 0 To n - 1 + p.ch(xx) = 0 + Next + + For xx = 0 To Len(szpassword) - 1 + p.ch(xx) = Asc(Mid(szpassword, xx + 1, 1)) + Next + + p.ch(xx) = Chr(0) ' Put Null Terminator For C + + ZDLLPass = 0 + +End Function + +'-- Callback For ZIP32z64.DLL - DLL Comment Function +Public Function ZDLLComm(ByRef s1 As ZipCBChar) As Integer + + Dim comment As String + Dim xx%, szcomment$ + + '-- Always Put This In Callback Routines! + On Error Resume Next + + ZDLLComm = 1 + If Not IsEmpty(ArchiveCommentText) Then + ' use text given to SetZipOptions + szcomment = ArchiveCommentText + Else + For xx = 0 To 4095 + szcomment = szcomment & Chr(s1.ch(xx)) + If s1.ch(xx) = 0 Then + Exit For + End If + Next + comment = InputBox("Enter or edit the comment", Default:=szcomment) + If comment = "" Then + ' either empty comment or Cancel button + If MsgBox("Remove comment?" & Chr(13) & "Hit No to keep existing comment", vbYesNo) = vbYes Then + szcomment = comment + Else + Exit Function + End If + End If + szcomment = comment + End If + 'If szcomment = "" Then Exit Function + For xx = 0 To Len(szcomment) - 1 + s1.ch(xx) = Asc(Mid$(szcomment, xx + 1, 1)) + Next xx + s1.ch(xx) = 0 ' Put null terminator for C + +End Function + +' This function can be used to set options in VB +Public Function SetZipOptions(ByRef ZipOpts As ZpOpt, _ + Optional ByVal ZipMode As ZipModeType = Add, _ + Optional ByVal RootDirToZipFrom As String = "", _ + Optional ByVal CompressionLevel As CompressionLevelType = c6_Default, _ + Optional ByVal RecurseSubdirectories As RecurseType = NoRecurse, _ + Optional ByVal Verboseness As VerbosenessType = Normal, _ + Optional ByVal i_IncludeFiles As String = "", _ + Optional ByVal x_ExcludeFiles As String = "", _ + Optional ByVal UpdateSFXOffsets As Boolean = False, Optional ByVal JunkDirNames As Boolean = False, _ + Optional ByVal Encrypt As Boolean = False, Optional ByVal Password As String = "", _ + Optional ByVal Repair As RepairType = NoRepair, Optional ByVal NoDirEntries As Boolean = False, _ + Optional ByVal GrowExistingArchive As Boolean = False, _ + Optional ByVal JunkSFXPrefix As Boolean = False, Optional ByVal ForceUseOfDOSNames As Boolean = False, _ + Optional ByVal Translate_LF As Translate_LF_Type = No_Line_End_Trans, _ + Optional ByVal Move_DeleteAfterAddedOrUpdated As Boolean = False, _ + Optional ByVal SetZipTimeToLatestTime As Boolean = False, _ + Optional ByVal IncludeSystemAndHiddenFiles As Boolean = False, _ + Optional ByVal ExcludeEarlierThanDate As String = "", _ + Optional ByVal IncludeEarlierThanDate As String = "", _ + Optional ByVal IncludeVolumeLabel As Boolean = False, _ + Optional ByVal ArchiveComment As Boolean = False, _ + Optional ByVal ArchiveCommentTextString = Empty, _ + Optional ByVal UsePrivileges As Boolean = False, _ + Optional ByVal ExcludeExtraAttributes As Boolean = False, Optional ByVal SplitSize As String = "", _ + Optional ByVal TempDirPath As String = "") As Boolean + + Dim SplitNum As Long + Dim SplitMultS As String + Dim SplitMult As Long + + ' set some defaults + ZipOpts.date = vbNullString + ZipOpts.szRootDir = vbNullString + ZipOpts.szTempDir = vbNullString + ZipOpts.fTemp = 0 + ZipOpts.fSuffix = 0 + ZipOpts.fEncrypt = 0 + ZipOpts.fSystem = 0 + ZipOpts.fVolume = 0 + ZipOpts.fExtra = 0 + ZipOpts.fNoDirEntries = 0 + ZipOpts.fExcludeDate = 0 + ZipOpts.fIncludeDate = 0 + ZipOpts.fVerbose = 0 + ZipOpts.fQuiet = 0 + ZipOpts.fCRLF_LF = 0 + ZipOpts.fLF_CRLF = 0 + ZipOpts.fJunkDir = 0 + ZipOpts.fGrow = 0 + ZipOpts.fForce = 0 + ZipOpts.fMove = 0 + ZipOpts.fDeleteEntries = 0 + ZipOpts.fUpdate = 0 + ZipOpts.fFreshen = 0 + ZipOpts.fJunkSFX = 0 + ZipOpts.fLatestTime = 0 + ZipOpts.fComment = 0 + ZipOpts.fOffsets = 0 + ZipOpts.fPrivilege = 0 + ZipOpts.szSplitSize = vbNullString + ZipOpts.IncludeListCount = 0 + ZipOpts.szIncludeList = vbNullString + ZipOpts.ExcludeListCount = 0 + ZipOpts.szExcludeList = vbNullString + ZipOpts.fRecurse = 0 + ZipOpts.fRepair = 0 + ZipOpts.flevel = 0 + + If RootDirToZipFrom <> "" Then + ZipOpts.szRootDir = RootDirToZipFrom + End If + ZipOpts.flevel = Asc(CompressionLevel) + If UpdateSFXOffsets Then ZipOpts.fOffsets = 1 + + If i_IncludeFiles <> "" Then + ZipOpts.szIncludeList = i_IncludeFiles + End If + If x_ExcludeFiles <> "" Then + ZipOpts.szExcludeList = x_ExcludeFiles + End If + + If ZipMode = Add Then + ' default + ElseIf ZipMode = Delete Then + ZipOpts.fDeleteEntries = 1 + ElseIf ZipMode = Update Then + ZipOpts.fUpdate = 1 + Else + ZipOpts.fFreshen = 1 + End If + ZipOpts.fRepair = Repair + If GrowExistingArchive Then ZipOpts.fGrow = 1 + If Move_DeleteAfterAddedOrUpdated Then ZipOpts.fMove = 1 + + If Verboseness = Quiet Then + ZipOpts.fQuiet = 1 + ElseIf Verboseness = Verbose Then + ZipOpts.fVerbose = 1 + End If + + If ArchiveComment = False And Not IsEmpty(ArchiveCommentTextString) Then + MsgBox "Must set ArchiveComment = True to set ArchiveCommentTextString" + Exit Function + End If + If IsEmpty(ArchiveCommentTextString) Then + ArchiveCommentText = Empty + Else + ArchiveCommentText = ArchiveCommentTextString + End If + If ArchiveComment Then ZipOpts.fComment = 1 + + If NoDirEntries Then ZipOpts.fNoDirEntries = 1 + If JunkDirNames Then ZipOpts.fJunkDir = 1 + If Encrypt Then ZipOpts.fEncrypt = 1 + EncryptionPassword = Password + If JunkSFXPrefix Then ZipOpts.fJunkSFX = 1 + If ForceUseOfDOSNames Then ZipOpts.fForce = 1 + If Translate_LF = LF_To_CRLF Then ZipOpts.fLF_CRLF = 1 + If Translate_LF = CRLF_To_LF Then ZipOpts.fCRLF_LF = 1 + ZipOpts.fRecurse = RecurseSubdirectories + If IncludeSystemAndHiddenFiles Then ZipOpts.fSystem = 1 + + If SetZipTimeToLatestTime Then ZipOpts.fLatestTime = 1 + If ExcludeEarlierThanDate <> "" And IncludeEarlierThanDate <> "" Then + MsgBox "Both ExcludeEarlierThanDate and IncludeEarlierThanDate not " & Chr(10) & _ + "supported at same time" + Exit Function + End If + If ExcludeEarlierThanDate <> "" Then + ZipOpts.fIncludeDate = 1 + ZipOpts.date = ExcludeEarlierThanDate + End If + If IncludeEarlierThanDate <> "" Then + ZipOpts.fExcludeDate = 1 + ZipOpts.date = IncludeEarlierThanDate + End If + + If TempDirPath <> "" Then + ZipOpts.szTempDir = TempDirPath + ZipOpts.fTemp = 1 + End If + + If SplitSize <> "" Then + SplitSize = Trim(SplitSize) + SplitMultS = Right(SplitSize, 1) + SplitMultS = UCase(SplitMultS) + If (SplitMultS = "K") Then + SplitMult = 1024 + SplitNum = Val(Left(SplitSize, Len(SplitSize) - 1)) + ElseIf SplitMultS = "M" Then + SplitMult = 1024 * 1024& + SplitNum = Val(Left(SplitSize, Len(SplitSize) - 1)) + ElseIf SplitMultS = "G" Then + SplitMult = 1024 * 1024 * 1024& + SplitNum = Val(Left(SplitSize, Len(SplitSize) - 1)) + Else + SplitMult = 1024 * 1024& + SplitNum = Val(SplitSize) + End If + SplitNum = SplitNum * SplitMult + If SplitNum = 0 Then + MsgBox "SplitSize of 0 not supported" + Exit Function + ElseIf SplitNum < 64 * 1024& Then + MsgBox "SplitSize must be at least 64k" + Exit Function + End If + ZipOpts.szSplitSize = SplitSize + End If + + If IncludeVolumeLabel Then ZipOpts.fVolume = 1 + If UsePrivileges Then ZipOpts.fPrivilege = 1 + If ExcludeExtraAttributes Then ZipOpts.fExtra = 1 + + SetZipOptions = True + +End Function + +Function ChopNulls(ByVal Str) As String + Dim A As Integer + Dim C As String + + For A = 1 To Len(Str) + If Mid(Str, A, 1) = Chr(0) Then + ChopNulls = Left(Str, A - 1) + Exit Function + End If + Next + ChopNulls = Str + +End Function +Sub DisplayVersion() + + ' display version of DLL + Dim Beta As Boolean + Dim ZLIB As Boolean + Dim Zip64 As Boolean + Dim Flags As String + Dim A As Integer + + ZipVersion.structlen = Len(ZipVersion) + ZpVersion ZipVersion + ' Check flag + If ZipVersion.flag And 1 Then + Flags = Flags & " Beta," + Beta = True + Else + Flags = Flags & " No Beta," + End If + If ZipVersion.flag And 2 Then + Flags = Flags & " ZLIB," + ZLIB = True + Else + Flags = Flags & " No ZLIB," + End If + If ZipVersion.flag And 4 Then + Flags = Flags & " Zip64, " + Zip64 = True + Else + Flags = Flags & " No Zip64, " + End If + If ZipVersion.encryption Then + Flags = Flags & "Encryption" + Else + Flags = Flags & " No encryption" + End If + + Form1.Caption = "Using Zip32z64.DLL Version " & _ + ZipVersion.ZipVersion.Major & "." & ZipVersion.ZipVersion.Minor & " " & _ + ChopNulls(ZipVersion.Beta) & " [" & ChopNulls(ZipVersion.date) & "]" & _ + " - FLAGS: " & Flags + + If Not Zip64 Then + A = MsgBox("Zip32z64.dll not compiled with Zip64 enabled - continue?", _ + vbOKCancel, _ + "Wrong dll") + If A = vbCancel Then + End + End If + End If + +End Sub + +'-- Main ZIP32.DLL Subroutine. +'-- This Is Where It All Happens!!! +'-- +'-- (WARNING!) Do Not Change This Function!!! +'-- +Public Function VBZip32() As Long + + Dim retcode As Long + Dim FileNotFound As Boolean + + ' On Error Resume Next '-- Nothing Will Go Wrong :-) + On Error GoTo ZipError + + retcode = 0 + + '-- Set Address Of ZIP32.DLL Callback Functions + '-- (WARNING!) Do Not Change!!! (except as noted below) + ZUSER.ZDLLPrnt = FnPtr(AddressOf ZDLLPrnt) + ZUSER.ZDLLPASSWORD = FnPtr(AddressOf ZDLLPass) + ZUSER.ZDLLCOMMENT = FnPtr(AddressOf ZDLLComm) + ZUSER.ZDLLSERVICE_NO_INT64 = FnPtr(AddressOf ZDLLServ) + + ' If you need to set destination of each split set this + 'ZUSER.ZDLLSPLIT = FnPtr(AddressOf ZDLLSplitSelect) + + '-- Set ZIP32.DLL Callbacks - return 1 if DLL loaded 0 if not + retcode = ZpInit(ZUSER) + If retcode = 0 And FileNotFound Then + MsgBox "Probably could not find Zip32z64.DLL - have you copied" & Chr(10) & _ + "it to the System directory, your program directory, " & Chr(10) & _ + "or a directory on your command PATH?" + VBZip32 = retcode + Exit Function + End If + + DisplayVersion + + If strZipFileNames = "" Then + ' not using string of names to zip (so using array of names) + strZipFileNames = vbNullString + End If + + '-- Go Zip It Them Up! + retcode = ZpArchive(zArgc, zZipArchiveName, zZipFileNames, strZipFileNames, ZOPT) + + '-- Return The Function Code + VBZip32 = retcode + + Exit Function + +ZipError: + MsgBox "Error: " & Err.Description + If Err = 48 Then + FileNotFound = True + End If + Resume Next + +End Function + |