forked from KolibriOS/kolibrios
715 lines
27 KiB
QBasic
715 lines
27 KiB
QBasic
Attribute VB_Name = "VBUnzBas"
|
|
Option Explicit
|
|
|
|
'-- Please Do Not Remove These Comment Lines!
|
|
'----------------------------------------------------------------
|
|
'-- Sample VB 5 / VB 6 code to drive unzip32.dll
|
|
'-- Contributed to the Info-ZIP project by Mike Le Voi
|
|
'--
|
|
'-- Contact me at: mlevoi@modemss.brisnet.org.au
|
|
'--
|
|
'-- Visit my home page at: http://modemss.brisnet.org.au/~mlevoi
|
|
'--
|
|
'-- Use this code at your own risk. Nothing implied or warranted
|
|
'-- to work on your machine :-)
|
|
'----------------------------------------------------------------
|
|
'--
|
|
'-- This Source Code Is Freely Available From The Info-ZIP Project
|
|
'-- Web Server At:
|
|
'-- ftp://ftp.info-zip.org/pub/infozip/infozip.html
|
|
'--
|
|
'-- A Very Special Thanks To Mr. Mike Le Voi
|
|
'-- And Mr. Mike White
|
|
'-- And The Fine People Of The Info-ZIP Group
|
|
'-- For Letting Me Use And Modify Their Original
|
|
'-- Visual Basic 5.0 Code! Thank You Mike Le Voi.
|
|
'-- For Your Hard Work In Helping Me Get This To Work!!!
|
|
'---------------------------------------------------------------
|
|
'--
|
|
'-- Contributed To The Info-ZIP Project By Raymond L. King.
|
|
'-- Modified June 21, 1998
|
|
'-- By Raymond L. King
|
|
'-- Custom Software Designers
|
|
'--
|
|
'-- Contact Me At: king@ntplx.net
|
|
'-- ICQ 434355
|
|
'-- Or Visit Our Home Page At: http://www.ntplx.net/~king
|
|
'--
|
|
'---------------------------------------------------------------
|
|
'--
|
|
'-- Modified August 17, 1998
|
|
'-- by Christian Spieler
|
|
'-- (implemented sort of a "real" user interface)
|
|
'-- Modified May 11, 2003
|
|
'-- by Christian Spieler
|
|
'-- (use late binding for referencing the common dialog)
|
|
'-- Modified February 01, 2008
|
|
'-- by Christian Spieler
|
|
'-- (adapted DLL interface changes, fixed UZDLLPass callback)
|
|
'-- Modified December 08, 2008 to December 30, 2008
|
|
'-- by Ed Gordon
|
|
'-- Updated sample project for UnZip 6.0 unzip32.dll
|
|
'-- (support UnZip 6.0 flags and structures)
|
|
'-- Modified January 03, 2009
|
|
'-- by Christian Spieler
|
|
'-- (better solution for overwrite_all handling, use Double
|
|
'-- instead of Currency to stay safe against number overflow,
|
|
'-- corrected UZDLLServ_I32() calling interface,
|
|
'-- removed code that is unsupported under VB5)
|
|
'--
|
|
'---------------------------------------------------------------
|
|
|
|
'-- Expected Version data for the DLL compatibility check
|
|
'
|
|
' For consistency of the version checking algorithm, the version number
|
|
' constants "UzDLL_MinVer" and "UzDLL_MaxAPI" have to fullfil the
|
|
' condition "UzDLL_MinVer <= "UzDLL_MaxAPI".
|
|
' Version data supplied by a specific UnZip DLL always obey the
|
|
' relation "UzDLL Version" >= "UzDLL API".
|
|
|
|
'Oldest UnZip DLL version that is supported by this program
|
|
Private Const cUzDLL_MinVer_Major As Byte = 6
|
|
Private Const cUzDLL_MinVer_Minor As Byte = 0
|
|
Private Const cUzDLL_MinVer_Revis As Byte = 0
|
|
|
|
'Last (newest) UnZip DLL API version that is known (and supported)
|
|
'by this program
|
|
Private Const cUzDLL_MaxAPI_Major As Byte = 6
|
|
Private Const cUzDLL_MaxAPI_Minor As Byte = 0
|
|
Private Const cUzDLL_MaxAPI_Revis As Byte = 0
|
|
|
|
'Current structure version ID of the DCLIST structure layout
|
|
Private Const cUz_DCLStructVer As Long = &H600
|
|
|
|
'-- C Style argv
|
|
Private Type UNZIPnames
|
|
uzFiles(0 To 99) As String
|
|
End Type
|
|
|
|
'-- Callback Large "String"
|
|
Private Type UNZIPCBChar
|
|
ch(32800) As Byte
|
|
End Type
|
|
|
|
'-- Callback Small "String"
|
|
Private Type UNZIPCBCh
|
|
ch(256) As Byte
|
|
End Type
|
|
|
|
'-- UNZIP32.DLL DCL Structure
|
|
Private Type DCLIST
|
|
StructVersID As Long ' Currently version &H600 of this structure
|
|
ExtractOnlyNewer As Long ' 1 = Extract Only Newer/New, Else 0
|
|
SpaceToUnderscore As Long ' 1 = Convert Space To Underscore, Else 0
|
|
PromptToOverwrite As Long ' 1 = Prompt To Overwrite Required, Else 0
|
|
fQuiet As Long ' 2 = No Messages, 1 = Less, 0 = All
|
|
ncflag As Long ' 1 = Write To Stdout, Else 0
|
|
ntflag As Long ' 1 = Test Zip File, Else 0
|
|
nvflag As Long ' 0 = Extract, 1 = List Zip Contents
|
|
nfflag As Long ' 1 = Extract Only Newer Over Existing, Else 0
|
|
nzflag As Long ' 1 = Display Zip File Comment, Else 0
|
|
ndflag As Long ' 0 = Junk paths, 1 = safe path components only, 2 = all
|
|
noflag As Long ' 1 = Overwrite Files, Else 0
|
|
naflag As Long ' 1 = Convert CR To CRLF, Else 0
|
|
nZIflag As Long ' 1 = Zip Info Verbose, Else 0
|
|
B_flag As Long ' 1 = Backup existing files, Else 0
|
|
C_flag As Long ' 1 = Case Insensitivity, 0 = Case Sensitivity
|
|
D_flag As Long ' Timestamp restoration, 0 = All, 1 = Files, 2 = None
|
|
U_flag As Long ' 0 = Unicode enabled, 1 = Escape chars, 2 = No Unicode
|
|
fPrivilege As Long ' 1 = ACL, 2 = Privileges
|
|
Zip As String ' The Zip Filename To Extract Files
|
|
ExtractDir As String ' The Extraction Directory, NULL If Extracting To Current Dir
|
|
End Type
|
|
|
|
'-- UNZIP32.DLL Userfunctions Structure
|
|
Private Type USERFUNCTION
|
|
UZDLLPrnt As Long ' Pointer To Apps Print Function
|
|
UZDLLSND As Long ' Pointer To Apps Sound Function
|
|
UZDLLREPLACE As Long ' Pointer To Apps Replace Function
|
|
UZDLLPASSWORD As Long ' Pointer To Apps Password Function
|
|
' 64-bit versions (VB6 does not support passing 64-bit values!)
|
|
UZDLLMESSAGE As Long ' Pointer To Apps Message Function (Not Used!)
|
|
UZDLLSERVICE As Long ' Pointer To Apps Service Function (Not Used!)
|
|
' 32-bit versions
|
|
UZDLLMESSAGE_I32 As Long ' Pointer To Apps Message Function
|
|
UZDLLSERVICE_I32 As Long ' Pointer To Apps Service Function
|
|
' All 64-bit values passed as low and high parts!
|
|
TotalSizeComp_Lo As Long ' Total Size Of Zip Archive (low 32 bits)
|
|
TotalSizeComp_Hi As Long ' Total Size Of Zip Archive (high 32 bits)
|
|
TotalSize_Lo As Long ' Total Size Of All Files In Archive (low 32)
|
|
TotalSize_Hi As Long ' Total Size Of All Files In Archive (high 32)
|
|
NumMembers_Lo As Long ' Total Number Of All Files In The Archive (low 32)
|
|
NumMembers_Hi As Long ' Total Number Of All Files In The Archive (high 32)
|
|
CompFactor As Long ' Compression Factor
|
|
cchComment As Integer ' Flag If Archive Has A Comment!
|
|
End Type
|
|
|
|
'-- UNZIP32.DLL Version Structure
|
|
Private Type UZPVER2
|
|
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
|
|
unzip(1 To 4) As Byte ' Version Type Unzip
|
|
zipinfo(1 To 4) As Byte ' Version Type Zip Info
|
|
os2dll As Long ' Version Type OS2 DLL
|
|
windll(1 To 4) As Byte ' Version Type Windows DLL
|
|
dllapimin(1 To 4) As Byte ' Version Type DLL API minimum compatibility
|
|
End Type
|
|
|
|
'-- This assumes UNZIP32.DLL is somewhere on your execution path!
|
|
'-- The term "execution path" means a search in the following locations,
|
|
'-- in the listed sequence (for more details look up the documentation
|
|
'-- of the LoadLibrary() Win32 API call):
|
|
'-- 1) the directory from which the VB6 application was loaded,
|
|
'-- 2) your current working directory in effect when the VB6 program
|
|
'-- tries to access a first API call of UNZIP32.DLL,
|
|
'-- 3) the Windows "SYSTEM32" (only NT/2K/XP...) and "SYSTEM" directories,
|
|
'-- and the Windows directory,
|
|
'-- 4) the folder list of your command path (e.g. check the environment
|
|
'-- variable PATH as set in a console window started from scratch).
|
|
'-- Normally, the Windows system directory is on your command path,
|
|
'-- so installing the UNZIP32.DLL in the Windows System Directory
|
|
'-- should always work.
|
|
'--
|
|
'-- WARNING:
|
|
'-- When a VB6 program is run in the VB6 IDE, the "directory from which the
|
|
'-- application was loaded" is the
|
|
'-- ===>>> directory where VB6.EXE is stored (!!!),
|
|
'-- not the storage directory of the VB project file
|
|
'-- (the folder returned by "App.Path").
|
|
'-- When a compiled VB6 program is run, the "application load directory"
|
|
'-- is identical with the folder reported by "App.Path".
|
|
'--
|
|
Private Declare Function Wiz_SingleEntryUnzip Lib "unzip32.dll" _
|
|
(ByVal ifnc As Long, ByRef ifnv As UNZIPnames, _
|
|
ByVal xfnc As Long, ByRef xfnv As UNZIPnames, _
|
|
dcll As DCLIST, Userf As USERFUNCTION) As Long
|
|
|
|
Private Declare Function UzpVersion2 Lib "unzip32.dll" _
|
|
(uzpv As UZPVER2) As Long
|
|
|
|
'-- Private variable holding the API version id as reported by the
|
|
'-- loaded UnZip DLL
|
|
Private m_UzDllApiVers As Long
|
|
|
|
'-- Private Variables For Structure Access
|
|
Private UZDCL As DCLIST
|
|
Private UZUSER As USERFUNCTION
|
|
Private UZVER2 As UZPVER2
|
|
|
|
'-- Public Variables For Setting The
|
|
'-- UNZIP32.DLL DCLIST Structure
|
|
'-- These Must Be Set Before The Actual Call To VBUnZip32
|
|
Public uExtractOnlyNewer As Long ' 1 = Extract Only Newer/New, Else 0
|
|
Public uSpaceUnderScore As Long ' 1 = Convert Space To Underscore, Else 0
|
|
Public uPromptOverWrite As Long ' 1 = Prompt To Overwrite Required, Else 0
|
|
Public uQuiet As Long ' 2 = No Messages, 1 = Less, 0 = All
|
|
Public uWriteStdOut As Long ' 1 = Write To Stdout, Else 0
|
|
Public uTestZip As Long ' 1 = Test Zip File, Else 0
|
|
Public uExtractList As Long ' 0 = Extract, 1 = List Contents
|
|
Public uFreshenExisting As Long ' 1 = Update Existing by Newer, Else 0
|
|
Public uDisplayComment As Long ' 1 = Display Zip File Comment, Else 0
|
|
Public uHonorDirectories As Long ' 1 = Honor Directories, Else 0
|
|
Public uOverWriteFiles As Long ' 1 = Overwrite Files, Else 0
|
|
Public uConvertCR_CRLF As Long ' 1 = Convert CR To CRLF, Else 0
|
|
Public uVerbose As Long ' 1 = Zip Info Verbose
|
|
Public uCaseSensitivity As Long ' 1 = Case Insensitivity, 0 = Case Sensitivity
|
|
Public uPrivilege As Long ' 1 = ACL, 2 = Privileges, Else 0
|
|
Public uZipFileName As String ' The Zip File Name
|
|
Public uExtractDir As String ' Extraction Directory, Null If Current Directory
|
|
|
|
'-- Public Program Variables
|
|
Public uZipNumber As Long ' Zip File Number
|
|
Public uNumberFiles As Long ' Number Of Files
|
|
Public uNumberXFiles As Long ' Number Of Extracted Files
|
|
Public uZipMessage As String ' For Zip Message
|
|
Public uZipInfo As String ' For Zip Information
|
|
Public uZipNames As UNZIPnames ' Names Of Files To Unzip
|
|
Public uExcludeNames As UNZIPnames ' Names Of Zip Files To Exclude
|
|
Public uVbSkip As Boolean ' For DLL Password Function
|
|
|
|
'-- Puts A Function Pointer In A Structure
|
|
'-- For Callbacks.
|
|
Public Function FnPtr(ByVal lp As Long) As Long
|
|
|
|
FnPtr = lp
|
|
|
|
End Function
|
|
|
|
'-- Callback For UNZIP32.DLL - Receive Message Function
|
|
Public Sub UZReceiveDLLMessage_I32( _
|
|
ByVal ucsize_lo As Long, _
|
|
ByVal ucsize_hi As Long, _
|
|
ByVal csiz_lo As Long, _
|
|
ByVal csiz_hi As Long, _
|
|
ByVal cfactor As Integer, _
|
|
ByVal mo As Integer, _
|
|
ByVal dy As Integer, _
|
|
ByVal yr As Integer, _
|
|
ByVal hh As Integer, _
|
|
ByVal mm As Integer, _
|
|
ByVal c As Byte, _
|
|
ByRef fname As UNZIPCBCh, _
|
|
ByRef meth As UNZIPCBCh, _
|
|
ByVal crc As Long, _
|
|
ByVal fCrypt As Byte)
|
|
|
|
Dim s0 As String
|
|
Dim xx As Long
|
|
Dim cCh As Byte
|
|
Dim strout As String * 80
|
|
Dim ucsize As Double
|
|
Dim csiz As Double
|
|
|
|
'-- Always implement a runtime error handler in Callback Routines!
|
|
On Error Resume Next
|
|
|
|
'------------------------------------------------
|
|
'-- This Is Where The Received Messages Are
|
|
'-- Printed Out And Displayed.
|
|
'-- You Can Modify Below!
|
|
'------------------------------------------------
|
|
|
|
strout = Space$(80)
|
|
|
|
'-- For Zip Message Printing
|
|
If uZipNumber = 0 Then
|
|
Mid$(strout, 1, 50) = "Filename:"
|
|
Mid$(strout, 53, 4) = "Size"
|
|
Mid$(strout, 62, 4) = "Date"
|
|
Mid$(strout, 71, 4) = "Time"
|
|
uZipMessage = strout & vbNewLine
|
|
strout = Space$(80)
|
|
End If
|
|
|
|
s0 = ""
|
|
|
|
'-- Do Not Change This For Next!!!
|
|
For xx = 0 To UBound(fname.ch)
|
|
If fname.ch(xx) = 0 Then Exit For
|
|
s0 = s0 & Chr$(fname.ch(xx))
|
|
Next
|
|
|
|
ucsize = CnvI64Struct2Dbl(ucsize_lo, ucsize_hi)
|
|
csiz = CnvI64Struct2Dbl(csiz_lo, csiz_hi)
|
|
|
|
'-- Assign Zip Information For Printing
|
|
Mid$(strout, 1, 50) = Mid$(s0, 1, 50)
|
|
Mid$(strout, 51, 9) = Right$(" " & CStr(ucsize), 9)
|
|
Mid$(strout, 62, 3) = Right$("0" & Trim$(CStr(mo)), 2) & "/"
|
|
Mid$(strout, 65, 3) = Right$("0" & Trim$(CStr(dy)), 2) & "/"
|
|
Mid$(strout, 68, 2) = Right$("0" & Trim$(CStr(yr)), 2)
|
|
Mid$(strout, 72, 3) = Right$(Str$(hh), 2) & ":"
|
|
Mid$(strout, 75, 2) = Right$("0" & Trim$(CStr(mm)), 2)
|
|
|
|
' Mid$(strout, 77, 2) = Right$(" " & CStr(cfactor), 2)
|
|
' Mid$(strout, 80, 8) = Right$(" " & CStr(csiz), 8)
|
|
' s0 = ""
|
|
' For xx = 0 To 255
|
|
' If meth.ch(xx) = 0 Then Exit For
|
|
' s0 = s0 & Chr$(meth.ch(xx))
|
|
' Next xx
|
|
|
|
'-- Do Not Modify Below!!!
|
|
uZipMessage = uZipMessage & strout & vbNewLine
|
|
uZipNumber = uZipNumber + 1
|
|
|
|
End Sub
|
|
|
|
'-- Callback For UNZIP32.DLL - Print Message Function
|
|
Public Function UZDLLPrnt(ByRef fname As UNZIPCBChar, ByVal x As Long) As Long
|
|
|
|
Dim s0 As String
|
|
Dim xx As Long
|
|
Dim cCh As Byte
|
|
|
|
'-- Always implement a runtime error handler in Callback Routines!
|
|
On Error Resume Next
|
|
|
|
s0 = ""
|
|
|
|
'-- Gets The UNZIP32.DLL Message For Displaying.
|
|
For xx = 0 To x - 1
|
|
cCh = fname.ch(xx)
|
|
Select Case cCh
|
|
Case 0
|
|
Exit For
|
|
Case 10
|
|
s0 = s0 & vbNewLine ' Damn UNIX :-)
|
|
Case 92 ' = Asc("\")
|
|
s0 = s0 & "/"
|
|
Case Else
|
|
s0 = s0 & Chr$(cCh)
|
|
End Select
|
|
Next
|
|
|
|
'-- Assign Zip Information
|
|
uZipInfo = uZipInfo & s0
|
|
|
|
UZDLLPrnt = 0
|
|
|
|
End Function
|
|
|
|
'-- Callback For UNZIP32.DLL - DLL Service Function
|
|
Public Function UZDLLServ_I32(ByRef mname As UNZIPCBChar, _
|
|
ByVal lUcSiz_Lo As Long, ByVal lUcSiz_Hi As Long) As Long
|
|
|
|
Dim UcSiz As Double
|
|
Dim s0 As String
|
|
Dim xx As Long
|
|
|
|
'-- Always implement a runtime error handler in Callback Routines!
|
|
On Error Resume Next
|
|
|
|
' Parameters lUcSiz_Lo and lUcSiz_Hi contain the uncompressed size
|
|
' of the extracted archive entry.
|
|
' This information may be used for some kind of progress display...
|
|
UcSiz = CnvI64Struct2Dbl(lUcSiz_Lo, lUcSiz_Hi)
|
|
|
|
s0 = ""
|
|
'-- Get Zip32.DLL Message For processing
|
|
For xx = 0 To UBound(mname.ch)
|
|
If mname.ch(xx) = 0 Then Exit For
|
|
s0 = s0 & Chr$(mname.ch(xx))
|
|
Next
|
|
' At this point, s0 contains the message passed from the DLL
|
|
' (like the current file being extracted)
|
|
' It is up to the developer to code something useful here :)
|
|
|
|
UZDLLServ_I32 = 0 ' Setting this to 1 will abort the zip!
|
|
|
|
End Function
|
|
|
|
'-- Callback For UNZIP32.DLL - Password Function
|
|
Public Function UZDLLPass(ByRef pwbuf As UNZIPCBCh, _
|
|
ByVal bufsiz As Long, ByRef promptmsg As UNZIPCBCh, _
|
|
ByRef entryname As UNZIPCBCh) As Long
|
|
|
|
Dim prompt As String
|
|
Dim xx As Long
|
|
Dim szpassword As String
|
|
|
|
'-- Always implement a runtime error handler in Callback Routines!
|
|
On Error Resume Next
|
|
|
|
UZDLLPass = -1 'IZ_PW_CANCEL
|
|
|
|
If uVbSkip Then Exit Function
|
|
|
|
'-- Get the Password prompt
|
|
For xx = 0 To UBound(promptmsg.ch)
|
|
If promptmsg.ch(xx) = 0 Then Exit For
|
|
prompt = prompt & Chr$(promptmsg.ch(xx))
|
|
Next
|
|
If Len(prompt) = 0 Then
|
|
prompt = "Please Enter The Password!"
|
|
Else
|
|
prompt = prompt & " "
|
|
For xx = 0 To UBound(entryname.ch)
|
|
If entryname.ch(xx) = 0 Then Exit For
|
|
prompt = prompt & Chr$(entryname.ch(xx))
|
|
Next
|
|
End If
|
|
|
|
'-- Get The Zip File Password
|
|
Do
|
|
szpassword = InputBox(prompt)
|
|
If Len(szpassword) < bufsiz Then Exit Do
|
|
' -- Entered password exceeds UnZip's password buffer size
|
|
If MsgBox("The supplied password exceeds the maximum password length " _
|
|
& CStr(bufsiz - 1) & " supported by the UnZip DLL." _
|
|
, vbExclamation + vbRetryCancel, "UnZip password too long") _
|
|
= vbCancel Then
|
|
szpassword = ""
|
|
Exit Do
|
|
End If
|
|
Loop
|
|
|
|
'-- No Password So Exit The Function
|
|
If Len(szpassword) = 0 Then
|
|
uVbSkip = True
|
|
Exit Function
|
|
End If
|
|
|
|
'-- Zip File Password So Process It
|
|
For xx = 0 To bufsiz - 1
|
|
pwbuf.ch(xx) = 0
|
|
Next
|
|
'-- Password length has already been checked, so
|
|
'-- it will fit into the communication buffer.
|
|
For xx = 0 To Len(szpassword) - 1
|
|
pwbuf.ch(xx) = Asc(Mid$(szpassword, xx + 1, 1))
|
|
Next
|
|
|
|
pwbuf.ch(xx) = 0 ' Put Null Terminator For C
|
|
|
|
UZDLLPass = 0 ' IZ_PW_ENTERED
|
|
|
|
End Function
|
|
|
|
'-- Callback For UNZIP32.DLL - Report Function To Overwrite Files.
|
|
'-- This Function Will Display A MsgBox Asking The User
|
|
'-- If They Would Like To Overwrite The Files.
|
|
Public Function UZDLLReplacePrmt(ByRef fname As UNZIPCBChar, _
|
|
ByVal fnbufsiz As Long) As Long
|
|
|
|
Dim s0 As String
|
|
Dim xx As Long
|
|
Dim cCh As Byte
|
|
Dim bufmax As Long
|
|
|
|
'-- Always implement a runtime error handler in Callback Routines!
|
|
On Error Resume Next
|
|
|
|
UZDLLReplacePrmt = 100 ' 100 = Do Not Overwrite - Keep Asking User
|
|
s0 = ""
|
|
bufmax = UBound(fname.ch)
|
|
If bufmax >= fnbufsiz Then bufmax = fnbufsiz - 1
|
|
|
|
For xx = 0 To bufmax
|
|
cCh = fname.ch(xx)
|
|
Select Case cCh
|
|
Case 0
|
|
Exit For
|
|
Case 92 ' = Asc("\")
|
|
s0 = s0 & "/"
|
|
Case Else
|
|
s0 = s0 & Chr$(cCh)
|
|
End Select
|
|
Next
|
|
|
|
'-- This Is The MsgBox Code
|
|
xx = MsgBox("Overwrite """ & s0 & """ ?", vbExclamation Or vbYesNoCancel, _
|
|
"VBUnZip32 - File Already Exists!")
|
|
Select Case xx
|
|
Case vbYes
|
|
UZDLLReplacePrmt = 102 ' 102 = Overwrite, 103 = Overwrite All
|
|
Case vbCancel
|
|
UZDLLReplacePrmt = 104 ' 104 = Overwrite None
|
|
Case Else
|
|
'keep the default as set at function entry.
|
|
End Select
|
|
|
|
End Function
|
|
|
|
'-- ASCIIZ To String Function
|
|
Public Function szTrim(szString As String) As String
|
|
|
|
Dim pos As Long
|
|
|
|
pos = InStr(szString, vbNullChar)
|
|
|
|
Select Case pos
|
|
Case Is > 1
|
|
szTrim = Trim$(Left$(szString, pos - 1))
|
|
Case 1
|
|
szTrim = ""
|
|
Case Else
|
|
szTrim = Trim$(szString)
|
|
End Select
|
|
|
|
End Function
|
|
|
|
'-- convert a 64-bit int divided in two Int32 variables into
|
|
'-- a single 64-bit floating-point value
|
|
Private Function CnvI64Struct2Dbl(ByVal lInt64Lo As Long, lInt64Hi As Long) As Double
|
|
If lInt64Lo < 0 Then
|
|
CnvI64Struct2Dbl = 2# ^ 32 + CDbl(lInt64Lo)
|
|
Else
|
|
CnvI64Struct2Dbl = CDbl(lInt64Lo)
|
|
End If
|
|
CnvI64Struct2Dbl = CnvI64Struct2Dbl + (2# ^ 32) * CDbl(lInt64Hi)
|
|
End Function
|
|
|
|
'-- Concatenate a "structured" version number into a single integer value,
|
|
'-- to facilitate version number comparisons
|
|
'-- (In case the practically used NumMajor numbers will ever exceed 128, it
|
|
'-- should be considered to use the number type "Double" to store the
|
|
'-- concatenated number. "Double" can store signed integer numbers up to a
|
|
'-- width of 52 bits without loss of precision.)
|
|
Private Function ConcatVersNums(ByVal NumMajor As Byte, ByVal NumMinor As Byte _
|
|
, ByVal NumRevis As Byte, ByVal NumBuild As Byte) As Long
|
|
If (NumMajor And &H80) <> 0 Then
|
|
ConcatVersNums = (NumMajor And &H7F) * (2 ^ 24) Or &H80000000
|
|
Else
|
|
ConcatVersNums = NumMajor * (2 ^ 24)
|
|
End If
|
|
ConcatVersNums = ConcatVersNums _
|
|
+ NumMinor * (2 ^ 16) _
|
|
+ NumRevis * (2 ^ 8) _
|
|
+ NumBuild
|
|
End Function
|
|
|
|
'-- Helper function to provide a printable version number string, using the
|
|
'-- current formatting rule for version number display as implemented in UnZip.
|
|
Private Function VersNumsToTxt(ByVal NumMajor As Byte, ByVal NumMinor As Byte _
|
|
, ByVal NumRevis As Byte) As String
|
|
VersNumsToTxt = CStr(NumMajor) & "." & Hex$(NumMinor)
|
|
If NumRevis <> 0 Then VersNumsToTxt = VersNumsToTxt & Hex$(NumRevis)
|
|
End Function
|
|
|
|
'-- Helper function to convert a "concatenated" version id into a printable
|
|
'-- version number string, using the current formatting rule for version number
|
|
'-- display as implemented in UnZip.
|
|
Private Function VersIDToTxt(ByVal VersionID As Long) As String
|
|
Dim lNumTemp As Long
|
|
|
|
lNumTemp = VersionID \ (2 ^ 24)
|
|
If lNumTemp < 0 Then lNumTemp = 256 + lNumTemp
|
|
VersIDToTxt = CStr(lNumTemp) & "." _
|
|
& Hex$((VersionID And &HFF0000) \ &H10000)
|
|
lNumTemp = (VersionID And &HFF00&) \ &H100
|
|
If lNumTemp <> 0 Then VersIDToTxt = VersIDToTxt & Hex$(lNumTemp)
|
|
End Function
|
|
|
|
'-- Main UNZIP32.DLL UnZip32 Subroutine
|
|
'-- (WARNING!) Do Not Change!
|
|
Public Sub VBUnZip32()
|
|
|
|
Dim retcode As Long
|
|
Dim MsgStr As String
|
|
Dim TotalSizeComp As Double
|
|
Dim TotalSize As Double
|
|
Dim NumMembers As Double
|
|
|
|
'-- Set The UNZIP32.DLL Options
|
|
'-- (WARNING!) Do Not Change
|
|
UZDCL.StructVersID = cUz_DCLStructVer ' Current version of this structure
|
|
UZDCL.ExtractOnlyNewer = uExtractOnlyNewer ' 1 = Extract Only Newer/New
|
|
UZDCL.SpaceToUnderscore = uSpaceUnderScore ' 1 = Convert Space To Underscore
|
|
UZDCL.PromptToOverwrite = uPromptOverWrite ' 1 = Prompt To Overwrite Required
|
|
UZDCL.fQuiet = uQuiet ' 2 = No Messages 1 = Less 0 = All
|
|
UZDCL.ncflag = uWriteStdOut ' 1 = Write To Stdout
|
|
UZDCL.ntflag = uTestZip ' 1 = Test Zip File
|
|
UZDCL.nvflag = uExtractList ' 0 = Extract 1 = List Contents
|
|
UZDCL.nfflag = uFreshenExisting ' 1 = Update Existing by Newer
|
|
UZDCL.nzflag = uDisplayComment ' 1 = Display Zip File Comment
|
|
UZDCL.ndflag = uHonorDirectories ' 1 = Honour Directories
|
|
UZDCL.noflag = uOverWriteFiles ' 1 = Overwrite Files
|
|
UZDCL.naflag = uConvertCR_CRLF ' 1 = Convert CR To CRLF
|
|
UZDCL.nZIflag = uVerbose ' 1 = Zip Info Verbose
|
|
UZDCL.C_flag = uCaseSensitivity ' 1 = Case insensitivity, 0 = Case Sensitivity
|
|
UZDCL.fPrivilege = uPrivilege ' 1 = ACL 2 = Priv
|
|
UZDCL.Zip = uZipFileName ' ZIP Filename
|
|
UZDCL.ExtractDir = uExtractDir ' Extraction Directory, NULL If Extracting
|
|
' To Current Directory
|
|
|
|
'-- Set Callback Addresses
|
|
'-- (WARNING!!!) Do Not Change
|
|
UZUSER.UZDLLPrnt = FnPtr(AddressOf UZDLLPrnt)
|
|
UZUSER.UZDLLSND = 0& '-- Not Supported
|
|
UZUSER.UZDLLREPLACE = FnPtr(AddressOf UZDLLReplacePrmt)
|
|
UZUSER.UZDLLPASSWORD = FnPtr(AddressOf UZDLLPass)
|
|
UZUSER.UZDLLMESSAGE_I32 = FnPtr(AddressOf UZReceiveDLLMessage_I32)
|
|
UZUSER.UZDLLSERVICE_I32 = FnPtr(AddressOf UZDLLServ_I32)
|
|
|
|
'-- Set UNZIP32.DLL Version Space
|
|
'-- (WARNING!!!) Do Not Change
|
|
With UZVER2
|
|
.structlen = Len(UZVER2)
|
|
.beta = String$(10, vbNullChar)
|
|
.date = String$(20, vbNullChar)
|
|
.zlib = String$(10, vbNullChar)
|
|
End With
|
|
|
|
'-- Get Version
|
|
retcode = UzpVersion2(UZVER2)
|
|
If retcode <> 0 Then
|
|
MsgBox "Incompatible DLL version discovered!" & vbNewLine _
|
|
& "The UnZip DLL requires a version structure of length " _
|
|
& CStr(retcode) & ", but the VB frontend expects the DLL to need " _
|
|
& Len(UZVER2) & "bytes." & vbNewLine _
|
|
& vbNewLine & "The program cannot continue." _
|
|
, vbCritical + vbOKOnly, App.Title
|
|
Exit Sub
|
|
End If
|
|
|
|
' Check that the DLL version is sufficiently recent
|
|
If (ConcatVersNums(UZVER2.unzip(1), UZVER2.unzip(2) _
|
|
, UZVER2.unzip(3), UZVER2.unzip(4)) < _
|
|
ConcatVersNums(cUzDLL_MinVer_Major, cUzDLL_MinVer_Minor _
|
|
, cUzDLL_MinVer_Revis, 0)) Then
|
|
' The found UnZip DLL is too old!
|
|
MsgBox "Incompatible old DLL version discovered!" & vbNewLine _
|
|
& "This program requires an UnZip DLL version of at least " _
|
|
& VersNumsToTxt(cUzDLL_MinVer_Major, cUzDLL_MinVer_Minor, cUzDLL_MinVer_Revis) _
|
|
& ", but the version reported by the found DLL is only " _
|
|
& VersNumsToTxt(UZVER2.unzip(1), UZVER2.unzip(2), UZVER2.unzip(3)) _
|
|
& "." & vbNewLine _
|
|
& vbNewLine & "The program cannot continue." _
|
|
, vbCritical + vbOKOnly, App.Title
|
|
Exit Sub
|
|
End If
|
|
|
|
' Concatenate the DLL API version info into a single version id variable.
|
|
' This variable may be used later on to switch between different
|
|
' known variants of specific API calls or API structures.
|
|
m_UzDllApiVers = ConcatVersNums(UZVER2.dllapimin(1), UZVER2.dllapimin(2) _
|
|
, UZVER2.dllapimin(3), UZVER2.dllapimin(4))
|
|
' check that the DLL API version is not too new
|
|
If (m_UzDllApiVers > _
|
|
ConcatVersNums(cUzDLL_MaxAPI_Major, cUzDLL_MaxAPI_Minor _
|
|
, cUzDLL_MaxAPI_Revis, 0)) Then
|
|
' The found UnZip DLL is too new!
|
|
MsgBox "DLL version with incompatible API discovered!" & vbNewLine _
|
|
& "This program can only handle UnZip DLL API versions up to " _
|
|
& VersNumsToTxt(cUzDLL_MaxAPI_Major, cUzDLL_MaxAPI_Minor, cUzDLL_MaxAPI_Revis) _
|
|
& ", but the found DLL reports a newer API version of " _
|
|
& VersIDToTxt(m_UzDllApiVers) & "." & vbNewLine _
|
|
& vbNewLine & "The program cannot continue." _
|
|
, vbCritical + vbOKOnly, App.Title
|
|
Exit Sub
|
|
End If
|
|
|
|
'--------------------------------------
|
|
'-- You Can Change This For Displaying
|
|
'-- The Version Information!
|
|
'--------------------------------------
|
|
MsgStr$ = "DLL Date: " & szTrim(UZVER2.date)
|
|
MsgStr$ = MsgStr$ & vbNewLine$ & "Zip Info: " _
|
|
& VersNumsToTxt(UZVER2.zipinfo(1), UZVER2.zipinfo(2), UZVER2.zipinfo(3))
|
|
MsgStr$ = MsgStr$ & vbNewLine$ & "DLL Version: " _
|
|
& VersNumsToTxt(UZVER2.windll(1), UZVER2.windll(2), UZVER2.windll(3))
|
|
MsgStr$ = MsgStr$ & vbNewLine$ & "DLL API Compatibility: " _
|
|
& VersIDToTxt(m_UzDllApiVers)
|
|
MsgStr$ = MsgStr$ & vbNewLine$ & "--------------"
|
|
'-- End Of Version Information.
|
|
|
|
'-- Go UnZip The Files! (Do Not Change Below!!!)
|
|
'-- This Is The Actual UnZip Routine
|
|
retcode = Wiz_SingleEntryUnzip(uNumberFiles, uZipNames, uNumberXFiles, _
|
|
uExcludeNames, UZDCL, UZUSER)
|
|
'---------------------------------------------------------------
|
|
|
|
'-- If There Is An Error Display A MsgBox!
|
|
If retcode <> 0 Then _
|
|
MsgBox "UnZip DLL call returned error code #" & CStr(retcode) _
|
|
, vbExclamation, App.Title
|
|
|
|
'-- Add up 64-bit values
|
|
TotalSizeComp = CnvI64Struct2Dbl(UZUSER.TotalSizeComp_Lo, _
|
|
UZUSER.TotalSizeComp_Hi)
|
|
TotalSize = CnvI64Struct2Dbl(UZUSER.TotalSize_Lo, _
|
|
UZUSER.TotalSize_Hi)
|
|
NumMembers = CnvI64Struct2Dbl(UZUSER.NumMembers_Lo, _
|
|
UZUSER.NumMembers_Hi)
|
|
|
|
'-- You Can Change This As Needed!
|
|
'-- For Compression Information
|
|
MsgStr$ = MsgStr$ & vbNewLine & _
|
|
"Only Shows If uExtractList = 1 List Contents"
|
|
MsgStr$ = MsgStr$ & vbNewLine & "--------------"
|
|
MsgStr$ = MsgStr$ & vbNewLine & "Comment : " & UZUSER.cchComment
|
|
MsgStr$ = MsgStr$ & vbNewLine & "Total Size Comp : " _
|
|
& Format$(TotalSizeComp, "#,0")
|
|
MsgStr$ = MsgStr$ & vbNewLine & "Total Size : " _
|
|
& Format$(TotalSize, "#,0")
|
|
MsgStr$ = MsgStr$ & vbNewLine & "Compress Factor : %" & UZUSER.CompFactor
|
|
MsgStr$ = MsgStr$ & vbNewLine & "Num Of Members : " & NumMembers
|
|
MsgStr$ = MsgStr$ & vbNewLine & "--------------"
|
|
|
|
VBUnzFrm.txtMsgOut.Text = VBUnzFrm.txtMsgOut.Text & MsgStr$ & vbNewLine
|
|
End Sub
|