Archive-Unzip-Burst
view release on metacpan or search on metacpan
unzip-6.0/windll/vb/vbunzip.bas view on Meta::CPAN
'-- 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
unzip-6.0/windll/vb/vbunzip.bas view on Meta::CPAN
'-- 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
( run in 0.624 second using v1.01-cache-2.11-cpan-df04353d9ac )