Attribute VB_Name = "mZipFiles"
Option Explicit ' Simple wrapper for ZipSearch İRd

'-------------------------------------------------------------------
' Wrapper for UnZip 6.0 DLL for Win32 freely available from Info-ZIP
'-------------------------------------------------------------------
' Visit www.info-zip.org, and download the DLL from:
'
' ftp://ftp.info-zip.org/pub/infozip/win32/unz600dn.zip
'
' You don't have to register this DLL to work, just place it in the
' ZipSearch program folder, or better still drop it into the System
' or System32 folder.
'-------------------------------------------------------------------

'-- Structure for Unzip32 user callback functions
Private Type UZ6USERFUNCS
    uzlpPRINT     As Long  ' Pointer to the application's Callback Print function
    uzlpSOUND     As Long  ' Pointer to the application's Callback Sound function. This can be NULL if your application doesn't use sound.
    uzlpREPLACE   As Long  ' Pointer to the application's Callback Replace function
    uzlpPASSWORD  As Long  ' Pointer to the application's Callback for processing passwords
    uz___Junk     As Long  ' Not used
    uz____Junk    As Long  ' Not used
    uzlpMESSAGE   As Long  ' Pointer to the application's 'SendApplicationMessage' Callback function for displaying information about specific files in the archive. Used for listing the contents of the archive.
    uzlpSERVICE   As Long  ' Pointer to optional 'ServCallBk' Callback function for processing Windows messages, relaying information, or cancelling the operation, as well as giving option of a progress indicator. If this function returns non-zero, it will terminate what it is doing. It provides the application with the name of the archive member it has just processed, as well as it's original size.
   ' 64-bit values passed as low and high parts
    SizeComp_Lo   As Long  ' Total size of zip archive (low 32 bits), excluding the archive header and central directory list.
    SizeComp_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  ' Overall archive compression factor (unsigned long)
    cchComment As Integer  ' Flag set if archive has a Comment
End Type

'-- Unzip32.dll DCL structure
Private Type DCLIST6
    StructVersID      As Long    ' Currently version &H600 of this structure
    ExtractOnlyNewer  As Long    ' 1 to extract only new/newer, without queries for "update" without interaction, else 0
    SpaceToUnderscore As Long    ' 1 to convert space to underscore, else 0
    PromptToOverwrite As Long    ' 1 if prompt to overwrite required, else 0
    fQuiet            As Long    ' 2 for no messages, 1 is Less, 0 is All messages
    ncflag            As Long    ' 1 to write to stdout, else 0
    ntflag            As Long    ' 1 to test zip file, else 0
    nvflag            As Long    ' 1 for verbose listing zip contents, 0 to extract
    nfflag            As Long    ' 1 to freshen/extract only newer over existing, else 0
    nzflag            As Long    ' 1 to display zip file comment, else 0
    ndflag            As Long    ' 1 to honour directories-all are files/dir to be extracted, else 0 junk paths, 1 = safe path components only, 2 = all
    noflag            As Long    ' 1 to always overwrite files, else 0
    naflag            As Long    ' 1 to convert CR to CRLF end-of-line translation, else 0
    nZIflag           As Long    ' 1 for zip info verbose, else 0
    B_flag            As Long    ' 1 to backup existing files, Else 0
    C_flag            As Long    ' 1 for case insensitivity, 0 for 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
    nPrivilege        As Long    ' 1 to restore ACL's, 2 to use privileges, 0 ignor
    szZipName         As String  ' The zip filename to extract files from
    szExtractDir      As String  ' The extraction directory, vbNullString if extracting to current dir
End Type

Private Type ZipNames
    zFiles(99) As String
End Type

Private Type ZipCBChar
    ch(32800) As Byte
End Type

Private Type ZipCBCh
    ch(256) As Byte
End Type

Private Type UzpBuffer
    strlength As Long ' length of string
    strpointr As Long ' pointer to string
End Type

Private Declare Function Wiz_SingleEntryUnzip Lib "unzip32" _
    (ByVal ifnc As Long, ByRef ifnv As ZipNames, _
     ByVal xfnc As Long, ByRef xfnv As ZipNames, _
     ByRef lpDCL As DCLIST6, ByRef lpUserFuncs As UZ6USERFUNCS) As Long

Private Declare Function Wiz_UnzipToMemory Lib "unzip32" _
    (ByVal lpszZip As String, ByVal lpszFile As String, _
     ByRef lpUserFuncs As UZ6USERFUNCS, ByRef lpRetStr As UzpBuffer) As Long

' Release the return data space allocated by Wiz_UnzipToMemory()
Private Declare Sub UzpFreeMemBuffer Lib "unzip32" (ByRef lpRetStr As UzpBuffer)

Private uzUser As UZ6USERFUNCS

Private Const cUz_StructVer As Long = &H600

'-------------------------------------------------------------------

Private Declare Sub CopyMemByV Lib "kernel32" Alias "RtlMoveMemory" _
    (ByVal lpDest As Long, ByVal lpSrc As Long, ByVal lLenB As Long)

Private Declare Sub CopyMemByR Lib "kernel32" Alias "RtlMoveMemory" _
    (ByRef lpvDest As Any, ByRef lpvSrc As Any, ByVal lLenB As Long)

'-------------------------------------------------------------------

Private Type SYSTEMTIME
    wYear         As Integer  ' Specifies the current year.
    wMonth        As Integer  ' Specifies the current month; January = 1, February = 2, and so on.
    wDayOfWeek    As Integer  ' Specifies the current day of the week; Sunday = 0, Monday = 1, and so on.
    wDay          As Integer  ' Specifies the current day of the month.
    wHour         As Integer  ' Specifies the current hour.
    wMinute       As Integer  ' Specifies the current minute.
    wSecond       As Integer  ' Specifies the current second.
    wMilliseconds As Integer  ' Specifies the current millisecond.
End Type

Private Declare Function SystemTimeToFileTime Lib "kernel32" _
    (lpSystemTime As SYSTEMTIME, lpFileTime As Currency) As Long

Private Declare Function SystemTimeToVariantTime Lib "oleaut32" _
    (lpSystemTime As SYSTEMTIME, vTime As Date) As Long

Private Declare Function VariantTimeToSystemTime Lib "oleaut32" _
    (ByVal vTime As Date, lpSystemTime As SYSTEMTIME) As Long

Public Type tZipFiles
   ftDate As Currency
    sSpec As String
    CRC32 As Long
    CSize As Long
    USize As Long
End Type

Private taZipFiles() As tZipFiles
Private mFilesCnt As Long

'-------------------------------------------------------------------

Private Sub InitFuncs()
    With uzUser
       .uzlpPRINT = FuncPtr(AddressOf UZDLLPrnt)
       .uzlpREPLACE = FuncPtr(AddressOf UZDLLRep)
       .uzlpPASSWORD = FuncPtr(AddressOf UZDLLPass)
       .uzlpMESSAGE = FuncPtr(AddressOf UZReceiveMsgs)
       .uzlpSERVICE = FuncPtr(AddressOf UZDLLServ)
    End With
End Sub

Private Function FuncPtr(ByVal AddressOf_Func As Long) As Long
    FuncPtr = AddressOf_Func
End Function

'-------------------------------------------------------------------

Public Function UnzipToMemory(sZipFile As String, sRelFile As String, sRetFileText As String) As Long

    Dim retStr As UzpBuffer ' Returns file size on success, zero on error
    Dim FileTxt() As Byte
    Dim sZipF As String
    Dim sFile As String
    Dim rc As Long

    On Error GoTo ErrHandler
    InitFuncs

    sZipF = Replace$(sZipFile, "\", "/")
    sFile = Replace$(sRelFile, "\", "/")

   '----------------------------------------------------------------
    rc = Wiz_UnzipToMemory(sZipF, sFile, uzUser, retStr)
   '----------------------------------------------------------------

    If Not (rc = 0&) Then
        ReDim FileTxt(retStr.strlength - 1) As Byte
        CopyMemByV VarPtr(FileTxt(0)), retStr.strpointr, retStr.strlength
    
        sRetFileText = StrConv(FileTxt, vbUnicode)
        UnzipToMemory = retStr.strlength

        UzpFreeMemBuffer retStr ' Clear buffer (thx2 Dave Carter :)
    End If

ErrHandler:
End Function

'-------------------------------------------------------------------

Public Function Unzip32_Neg1(sZipFile As String, sRelFile As String, sExtractDir As String) As Long
   
    Dim uZipNames As ZipNames ' Return -1 on success, zero on error
    Dim uExcNames As ZipNames
    Dim uzDCL As DCLIST6
    Dim rc As Long

    On Error GoTo ErrHandler
    InitFuncs
    uzDCL.StructVersID = cUz_StructVer
    uzDCL.PromptToOverwrite = 1&
    uzDCL.szZipName = Replace$(sZipFile, "\", "/")       ' The Zip file name
    uZipNames.zFiles(0) = Replace$(sRelFile, "\", "/")   ' The file to unzip
    uExcNames.zFiles(0) = vbNullString
    uzDCL.szExtractDir = Replace$(sExtractDir, "\", "/") ' Extraction dir, current if ""

   '-------------------------------------------------------------------
    rc = Wiz_SingleEntryUnzip(1&, uZipNames, 0&, uExcNames, uzDCL, uzUser)
   '-------------------------------------------------------------------

    Unzip32_Neg1 = (rc = 0&)
ErrHandler:
End Function

'-------------------------------------------------------------------

Public Function GetZipFileInfo(sZipFile As String, tFiles() As tZipFiles) As Long

    Dim uZipNames As ZipNames ' Returns file count on success, zero on error
    Dim uExcNames As ZipNames
    Dim retStr As UzpBuffer
    Dim sZipF As String
    Dim sFile As String
    Dim idx As Long
    Dim rc As Long

    On Error GoTo ErrHandler
    InitFuncs

    Dim uzDCL As DCLIST6
    uzDCL.StructVersID = cUz_StructVer
    uzDCL.nvflag = 1&
    uzDCL.szZipName = Replace$(sZipFile, "\", "/")

    ReDim taZipFiles(0 To 260) As tZipFiles
    mFilesCnt = 0&

   '-------------------------------------------------------------------
    rc = Wiz_SingleEntryUnzip(0&, uZipNames, 0&, uExcNames, uzDCL, uzUser)
   '-------------------------------------------------------------------

    If (rc = 0&) Then
        ReDim tFiles(0 To mFilesCnt - 1) As tZipFiles

        Do Until idx = mFilesCnt

            With taZipFiles(idx)
                tFiles(idx).sSpec = .sSpec
                tFiles(idx).CRC32 = .CRC32
                tFiles(idx).CSize = .CSize
                tFiles(idx).USize = .USize
                tFiles(idx).ftDate = .ftDate
            End With
            idx = idx + 1&

        Loop
        GetZipFileInfo = mFilesCnt
    End If
ErrHandler:
End Function

'-------------------------------------------------------------------

Private Sub UZReceiveMsgs(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 ZipCBCh, _
        ByRef meth As ZipCBCh, ByVal crc As Long, _
    ByVal fCrypt As Byte) ' UZ 6.0 +

    Dim tSysTime As SYSTEMTIME
    Dim aBytes() As Byte
    Dim dtDate As Date, i As Long

    On Error Resume Next

    Do Until fname.ch(i) = 0
        i = i + 1&
    Loop

    ReDim aBytes(i - 1) As Byte
    CopyMemByR aBytes(0), fname.ch(0), i

    tSysTime.wMonth = dy 'mo !
    tSysTime.wDay = mo 'dy !
    tSysTime.wYear = yr
    tSysTime.wHour = hh
    tSysTime.wMinute = mm

    SystemTimeToVariantTime tSysTime, dtDate ' Strange bug fix SystemTimeToFileTime sys->ft fails
    VariantTimeToSystemTime dtDate, tSysTime ' if passed directly but sys->vDate->sys->ft success

    With taZipFiles(mFilesCnt)
        .sSpec = Trim$(StrConv(aBytes, vbUnicode))
        .CRC32 = crc
        .CSize = csiz_lo
        .USize = ucsize_lo
        SystemTimeToFileTime tSysTime, .ftDate
    End With

    mFilesCnt = mFilesCnt + 1&
    If mFilesCnt > UBound(taZipFiles) Then
        ReDim Preserve taZipFiles(0 To UBound(taZipFiles) + 260) As tZipFiles
    End If

End Sub

'-------------------------------------------------------------------
Private Function UZDLLRep(fname As ZipCBCh, ByVal n As Long) As Long
'
End Function
Private Function UZDLLPass(pw As ZipCBCh, ByVal n As Long, m As ZipCBCh, name As ZipCBCh) As Long
'
End Function
Private Function UZDLLServ(mname As ZipCBChar, ByVal lUCSiz_Lo As Long, ByVal lUCSiz_Hi As Long) As Long
'
End Function
Private Function UZDLLPrnt(fname As ZipCBChar, ByVal cc As Long) As Long
'
End Function
'-------------------------------------------------------------------
' Rd :)
