[RESOLVED] How Do I Unzip a CAB file to the c:\temp folderm using VB6???

[ThEiMp]

I am writing some source code that is written to unzip a CAB file and then send the unzipped files into the Temp folder, from the source of a CD/DVD disc. How can I do this, and use miminual code to do it???

PS :=> Also I don't want to see the CAB file being unzipped, but only have it running in the background of the current machine that it is running on...

Thanks in advance...

[Zach_VB6]

Wrong section.

And look here: http://www.thescarms.com/vbasic/cabexplorer.aspx

[ThEiMp]

Sorry about the wrong section...

[Hack]

Moved To VB6 And Earlier

[dilettante]

Normally the volume of such operations is low enough that it isn't worth the trouble of writing and debugging code to do it.

I tend to look for an existing command line utility to handle the task, and then I run it using a piece of code that I have written and debugged already: my ShellPipe control. For well behaved programs that were intended to be "scriptable" (i.e. run in BAT/CMD files) this works great. Any command and status I/O is done via the standard I/O streams, which ShellPipe can redirect to anonymous pipes that it can "operate" from its end.

The result is that no command window ever need be created, let alone visible.


If you obtain the CabSDK you'll find a utility named Extract.exe that can do the job. It is documented in the SDK within the MAKECAB.DOC document. I've posted ShellPipe here enough times that a simple forum search should turn it up. Someday I should drop it into the CodeBank I suppose.

The nice thing about this approach is that if the need arises you can change archive formats from CAB to ZIP, etc. without a major session of program rewriting and debugging. Just substitute the appropriate utility, then adjust the command line used with ShellPipe to start it. Beyond that there may be some minor tweaking required if you submit runtime commands to the utility or analyze output from the utility. In the majority of cases though all you need are command line parameters for input, you can discard any output if the utility can't be run in silent mode, and then check the return code to detect success/failure.

The only thing ShelPipe really doesn't do is handle child process elevation. Someday I may have to add that option.

[ThEiMp]

Well: Now I am using PKZIP & PKUNZIP for DOS. Cause they are command line and also they have good access to long filenames, in the latest version as well. I wrote a BAT file for them, well only the PKUNZIP only, though.

[HackerVlad]

Wrong section.

And look here: http://www.thescarms.com/vbasic/cabexplorer.aspx

I wrote a mini-module for viewing the contents of CAB archives based on this code. I posted it here in ready-made solutions: https://www.vbforums.com/showthread....g-CAB-archives. And I also found a simple and fast way to extract CAB archives all in one line of code!

Example:

Private Sub Command1_Click()
    If ExtractFiles(App.Path & "\CabFile1.cab", App.Path, 0, vbNullString, 0, 0) = 0 Then
        Print "Archive has been fully successfully extracted"
    Else
        Print "Error"
    End If
End Sub

[HackerVlad]

I also want to add that I carefully tested the ready-made CabFile.cls class (I downloaded the project from the specified site thescarms.com...) and during my tests, I found bugs in this code. This class is buggy. And my code is simple and not buggy.
By the way, I forgot to say the main thing is that the declaration is correct.

Private Declare Function ExtractFiles Lib "advpack.dll" Alias "ExtractFilesA" (ByVal CabName As String, ByVal ExpandDir As String, ByVal Flags As Long, ByVal FileList As String, lpReserved As Any, ByVal Reserved As Long) As Long

[HackerVlad]

Option Explicit
'////////////////////////////////////////////////////////////////////
'// Module for reading and unpacking CAB archives                  //
'// Copyright (c) 2025-02-20 by HackerVlad                         //
'// e-mail: vladislavpeshkov@ya.ru                                 //
'// Version 2.5 (32 and 64-bit compatible) & Windows 98 compatible //
'////////////////////////////////////////////////////////////////////

' API declarations ...
#If VBA7 = 0 Then
Private Declare Function SetupIterateCabinetW Lib "setupapi" (ByVal CabinetFile As Long, ByVal Reserved As Long, ByVal MsgHandler As Long, ByVal Context As Long) As Long
Private Declare Function SetupIterateCabinetA Lib "setupapi" (ByVal CabinetFile As String, ByVal Reserved As Long, ByVal MsgHandler As Long, ByVal Context As Long) As Long
Private Declare Function PathRemoveFileSpecW Lib "shlwapi" (ByVal pszPath As Long) As Long
Private Declare Function SHCreateDirectory Lib "shell32" (ByVal hwnd As Long, ByVal pszPath As Long) As Long
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp" (ByVal lpPath As String) As Long ' For old versions of Windows
Private Declare Function SysReAllocString Lib "oleaut32" (ByVal pBSTR As Long, ByVal psz As Long) As Long
Private Declare Sub SysFreeString Lib "oleaut32" (ByVal bstr As Long)
Private Declare Function GetFileAttributesEx Lib "kernel32" Alias "GetFileAttributesExW" (ByVal lpFileName As Long, ByVal fInfoLevelId As Long, ByRef lpFileInformation As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function SetFileAttributesW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwFileAttributes As Long) As Long
Private Declare Function SetFileAttributesA Lib "kernel32" (ByVal lpFileName As Long, ByVal dwFileAttributes As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)

Private Enum LongPtr
    [_]
End Enum
#Else
Private Declare PtrSafe Function SetupIterateCabinetW Lib "setupapi" (ByVal CabinetFile As LongPtr, ByVal Reserved As Long, ByVal MsgHandler As LongPtr, ByVal Context As Long) As Long
Private Declare PtrSafe Function SetupIterateCabinetA Lib "setupapi" (ByVal CabinetFile As String, ByVal Reserved As Long, ByVal MsgHandler As LongPtr, ByVal Context As Long) As Long
Private Declare PtrSafe Function PathRemoveFileSpecW Lib "shlwapi" (ByVal pszPath As LongPtr) As Long
Private Declare PtrSafe Function SHCreateDirectory Lib "shell32" (ByVal hwnd As Long, ByVal pszPath As LongPtr) As Long
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp" (ByVal lpPath As String) As Long ' For old versions of Windows
Private Declare PtrSafe Function SysReAllocString Lib "oleaut32" (ByVal pBSTR As LongPtr, ByVal psz As LongPtr) As Long
Private Declare PtrSafe Sub SysFreeString Lib "oleaut32" (ByVal bstr As LongPtr)
Private Declare PtrSafe Function GetFileAttributesEx Lib "kernel32" Alias "GetFileAttributesExW" (ByVal lpFileName As LongPtr, ByVal fInfoLevelId As Long, ByRef lpFileInformation As Any) As Long
Private Declare PtrSafe Function lstrlenA Lib "kernel32" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function SetFileAttributesW Lib "kernel32" (ByVal lpFileName As LongPtr, ByVal dwFileAttributes As Long) As Long
Private Declare PtrSafe Function SetFileAttributesA Lib "kernel32" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Declare PtrSafe Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As Any) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare PtrSafe Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
#End If

' Constants ...
Private Const MAXPATH = 260
Private Const FILEOP_DOIT = 1
Private Const FILEOP_SKIP = 2
Private Const SPFILENOTIFY_FILEINCABINET = &H11
Private Const SPFILENOTIFY_FILEEXTRACTED = &H13
Private Const GetFileExInfoStandard As Long = 0

' Own fictional constants ...
Private Const sicList = 568
Private Const sicCount = 569
Private Const sicExtract = 570

' Variables for temporary data storage ...
Dim CountFilesSuccessfullyExtracted As Long, SetAttribsFile As Long, lngCount As Long
Dim strFileToExtract As String, strOutputPath As String
Dim arrFilesToExtract() As String
Dim arrListFilesCab() As CabInfo
Dim IsFilesList As Boolean, WinANSI As Boolean

' Structures ...
Public Type CabInfo
    cabFileName As String
    cabFileSize As Long
    cabDosDate As Integer
    cabDosTime As Integer
    cabDosAttribs As Integer
End Type

Private Type FileInCabinetInfoW
    NameInCabinet As LongPtr
    FileSize      As Long
    Win32Error    As Long
    DosDate       As Integer
    DosTime       As Integer
    DosAttribs    As Integer
    FullTargetName(MAXPATH - 1) As Integer ' WCHAR  FullTargetName[MAX_PATH];
End Type

Private Type FILEPATHS
    Target     As LongPtr
    Source     As LongPtr
    Win32Error As Integer
    Flags      As Long
End Type

Private Type WIN32_FILE_ATTRIBUTE_DATA
    dwFileAttributes    As Long
    ftCreationTime      As Currency
    ftLastAccessTime    As Currency
    ftLastWriteTime     As Currency
    nFileSizeHigh       As Long
    nFileSizeLow        As Long
End Type

' Does the directory exist (IsDir)
Public Function cabIsDir(ByVal path As String) As Boolean
    Dim tAttr As WIN32_FILE_ATTRIBUTE_DATA
    
    If GetFileAttributesEx(StrPtr(path), GetFileExInfoStandard, tAttr) <> 0 Then
        If (tAttr.dwFileAttributes And vbDirectory) <> 0 Then
            cabIsDir = True
        End If
    Else ' ANSI
        On Error Resume Next
        If Dir(path, vbDirectory + 7) <> vbNullString Then
            If (GetAttr(path) And vbDirectory) <> 0 Then cabIsDir = True
        End If
    End If
End Function

' Convert the full file path to the folder path (always returns "\" at the end)
Public Function cabExtractFilePath(ByVal FileName As String) As String
    Dim lNullPos As Long
    Dim pszPath As String
    
    pszPath = FileName
    PathRemoveFileSpecW StrPtr(pszPath)
    
    lNullPos = InStr(1, pszPath, vbNullChar)
    If lNullPos Then
        pszPath = Left$(pszPath, lNullPos - 1)
        If Right$(pszPath, 1) <> "\" Then pszPath = pszPath & "\"
        cabExtractFilePath = pszPath
    Else
        cabExtractFilePath = FileName
    End If
End Function

' Create multiple folders at once, for all versions of Windows (always requires a "\" at the end for systems less than WinXP)
Public Function MakeDir(ByVal path As String) As Boolean
    Dim inf(36) As Long
    Dim IsXPAndLater As Boolean
    
    inf(0) = 148: GetVersionEx inf(0): IsXPAndLater = inf(4) = 2 And inf(1) >= 5 And inf(2) >= 1 ' Get the Windows version
    
    If IsXPAndLater = True Then
        If SHCreateDirectory(0, StrPtr(path)) = 0 Then MakeDir = True
    Else
        If MakeSureDirectoryPathExists(path) = 1 Then MakeDir = True
    End If
End Function

Private Function CabinetCallback(ByVal Context As Long, ByVal Notification As Long, Param1 As FileInCabinetInfoW, ByVal Param2 As Long) As Long
    If Notification = SPFILENOTIFY_FILEINCABINET Then
        Dim FileNameInCab As String
        Dim bytesLen As Long
        
        Select Case Context
            Case sicCount
                lngCount = lngCount + 1
                CabinetCallback = FILEOP_SKIP ' Skip the file and go through the list of files next
                
            Case sicList
                If WinANSI = False Then
                    SysReAllocString VarPtr(FileNameInCab), Param1.NameInCabinet
                Else
                    bytesLen = lstrlenA(Param1.NameInCabinet)
                    FileNameInCab = Space$(bytesLen)
                    CopyMemory ByVal FileNameInCab, ByVal Param1.NameInCabinet, bytesLen + 1 ' Converts to Unicode using an implicit (hidden) conversion
                End If
                
                ' Add a position to the UDT array
                ReDim Preserve arrListFilesCab(lngCount)
                arrListFilesCab(lngCount).cabFileName = FileNameInCab
                arrListFilesCab(lngCount).cabFileSize = Param1.FileSize
                arrListFilesCab(lngCount).cabDosDate = Param1.DosDate
                arrListFilesCab(lngCount).cabDosTime = Param1.DosTime
                arrListFilesCab(lngCount).cabDosAttribs = Param1.DosAttribs
                
                lngCount = lngCount + 1
                CabinetCallback = FILEOP_SKIP ' Skip the file and go through the list of files next
                If WinANSI = False Then SysFreeString StrPtr(FileNameInCab)
                
            Case sicExtract
                Dim FileName As String, FilePath As String, FillFileName As String
                Dim i As Long
                
                If WinANSI = False Then
                    SysReAllocString VarPtr(FileNameInCab), Param1.NameInCabinet
                Else
                    bytesLen = lstrlenA(Param1.NameInCabinet)
                    FileNameInCab = Space$(bytesLen)
                    CopyMemory ByVal FileNameInCab, ByVal Param1.NameInCabinet, bytesLen + 1 ' Converts to Unicode using an implicit (hidden) conversion
                End If
                FileName = strOutputPath & "\" & FileNameInCab
                
                ' We fill in the value of the structure with the filename of the extracted file (+1 character at the end of the line is vbNullChar)
                If Not WinANSI Then FillFileName = FileName Else FillFileName = StrConv(FileName, vbFromUnicode) ' Convert to ANSI
                If Not WinANSI Then ZeroMemory Param1.FullTargetName(0), 520 Else ZeroMemory Param1.FullTargetName(0), 260
                CopyMemory Param1.FullTargetName(0), ByVal StrPtr(FillFileName), LenB(FillFileName) + 1
                
                If IsFilesList = False Then
                    If strFileToExtract = FileNameInCab Or Len(strFileToExtract) = 0 Then
                        FilePath = cabExtractFilePath(FileName)
                        If cabIsDir(FilePath) = False Then MakeDir FilePath
                        
                        SetAttribsFile = Param1.DosAttribs ' Remember the attributes
                        CabinetCallback = FILEOP_DOIT ' Extract the file
                        CountFilesSuccessfullyExtracted = CountFilesSuccessfullyExtracted + 1
                    Else
                        CabinetCallback = FILEOP_SKIP ' Skip the file and go through the list of files next
                    End If
                Else
                    Dim ExtractCurrentFile As Boolean
                    
                    For i = 0 To UBound(arrFilesToExtract)
                        If arrFilesToExtract(i) = FileNameInCab Then
                            ExtractCurrentFile = True
                            Exit For
                        End If
                    Next
                    
                    If ExtractCurrentFile = True Then
                        FilePath = cabExtractFilePath(FileName)
                        If cabIsDir(FilePath) = False Then MakeDir FilePath
                        
                        SetAttribsFile = Param1.DosAttribs ' Remember the attributes
                        CabinetCallback = FILEOP_DOIT ' Extract the file
                        CountFilesSuccessfullyExtracted = CountFilesSuccessfullyExtracted + 1
                    Else
                        CabinetCallback = FILEOP_SKIP ' Skip the file and go through the list of files next
                    End If
                End If
                
                If WinANSI = False Then SysFreeString StrPtr(FileNameInCab)
        End Select
    ElseIf Notification = SPFILENOTIFY_FILEEXTRACTED Then
        Dim fp As FILEPATHS
        
        LSet fp = Param1
        
        If fp.Win32Error = 0 Then ' If the file has been successfully extracted from the archive
            ' Manually set the attributes of the extracted file yourself,
            ' as Microsoft kindly refused to do this in the SetupIterateCabinet function
            If SetFileAttributesW(fp.Target, SetAttribsFile) = 0 Then
                SetFileAttributesA fp.Target, SetAttribsFile
            End If
        End If
    End If
End Function

' Get a list of files inside the CAB archive
Public Function GetFilesListInCab(ByVal cabFileName As String, arrCabInfo() As CabInfo) As Long
    lngCount = 0
    WinANSI = False
    
    If SetupIterateCabinetW(StrPtr(cabFileName), 0, AddressOf CabinetCallback, sicList) Then
        arrCabInfo = arrListFilesCab
        GetFilesListInCab = lngCount
        Erase arrListFilesCab
    Else
        WinANSI = True
        If SetupIterateCabinetA(cabFileName, 0, AddressOf CabinetCallback, sicList) Then
            arrCabInfo = arrListFilesCab
            GetFilesListInCab = lngCount
            Erase arrListFilesCab
        End If
    End If
End Function

' Get count of files inside the CAB archive
Public Function GetFilesCountInCab(ByVal cabFileName As String) As Long
    lngCount = 0
    
    If SetupIterateCabinetW(StrPtr(cabFileName), 0, AddressOf CabinetCallback, sicCount) Then
        GetFilesCountInCab = lngCount
    Else
        If SetupIterateCabinetA(cabFileName, 0, AddressOf CabinetCallback, sicCount) Then GetFilesCountInCab = lngCount
    End If
End Function

' Extract files from the CAB archive
' Extracting archives compressed using MSZIP works in Windows 95+
' Extracting archives compressed using LZX21 works in Windows Me+
' FileList - an extracted file from an archive (string) if there is one file, or an array of strings if there are several files to extract
' If the FileList parameter is omitted, all files from the archive will be extracted
Public Function ExtractFilesInCab(ByVal cabFileName As String, ByVal ExpandDir As String, Optional FileList As Variant) As Boolean
    If Len(cabFileName) > 0 And Len(ExpandDir) > 0 Then
        If Right$(ExpandDir, 1) = "\" Then
            strOutputPath = Mid$(ExpandDir, 1, Len(ExpandDir) - 1)
        Else
            strOutputPath = ExpandDir
        End If
        
        If cabIsDir(strOutputPath) = False Then
            If MakeDir(strOutputPath) = False Then Exit Function
        End If
        
        If VarType(FileList) = vbString Then
            strFileToExtract = FileList
        ElseIf VarType(FileList) = vbArray + vbString Then ' If it is an array of strings
            strFileToExtract = ""
            arrFilesToExtract = FileList
            IsFilesList = True
        Else
            strFileToExtract = ""
        End If
        
        CountFilesSuccessfullyExtracted = 0
        WinANSI = False
        
        If SetupIterateCabinetW(StrPtr(cabFileName), 0, AddressOf CabinetCallback, sicExtract) Then
            If IsFilesList = False Then
                If CountFilesSuccessfullyExtracted = 1 Or Len(strFileToExtract) = 0 Then ExtractFilesInCab = True
            Else
                If CountFilesSuccessfullyExtracted = UBound(arrFilesToExtract) + 1 Then ExtractFilesInCab = True
            End If
        Else
            WinANSI = True
            If SetupIterateCabinetA(cabFileName, 0, AddressOf CabinetCallback, sicExtract) Then
                If IsFilesList = False Then
                    If CountFilesSuccessfullyExtracted = 1 Or Len(strFileToExtract) = 0 Then ExtractFilesInCab = True
                Else
                    If CountFilesSuccessfullyExtracted = UBound(arrFilesToExtract) + 1 Then ExtractFilesInCab = True
                End If
            End If
        End If
        
        If IsFilesList = True Then
            IsFilesList = False
            Erase arrFilesToExtract
        End If
    End If
End Function

Example: https://www.vbforums.com/showthread....g-CAB-archives