[RESOLVED] The CAB Archive packaging module

[HackerVlad]

I suggested that you write code to packing CAB files. It was very difficult, but I wrote such a module anyway. You just need to understand that in order for the module to work in full, you need to use TwinBasic or you need to connect the CDeclFix add-on from The Trick.

Last update (2025-01-09): https://www.vbforums.com/showthread....=1#post5668210

The beginning of the first part of the module:

Option Explicit
'////////////////////////////////////////////
'// The CAB Archive packaging module       //
'// Copyright (c) 21.11.2024 by HackerVlad //
'// e-mail: [email protected]     //
'// Version 1.2                            //
'////////////////////////////////////////////

' API declarations ...
Private Declare Function FCICreate CDecl Lib "cabinet.dll" (perf As TERF, ByVal fnFilePlaced As Long, ByVal fnAlloc As Long, ByVal fnFree As Long, ByVal fnOpen As Long, ByVal fnRead As Long, ByVal fnWrite As Long, ByVal fnClose As Long, ByVal fnSeek As Long, ByVal fnDelete As Long, ByVal fnFciGTF As Long, ByVal ccab As Long, Optional ByVal pv As Long) As Long
Private Declare Function FCIAddFile CDecl Lib "cabinet.dll" (ByVal hfci As Long, ByVal pszSourceFile As Long, ByVal pszFileName As Long, ByVal fExecute As BOOL, ByVal pfnGetNextCabinet As Long, ByVal pfnProgress As Long, ByVal pfnOpenInfo As Long, ByVal typeCompress As Long) As Long
Private Declare Function FCIFlushCabinet CDecl Lib "cabinet.dll" (ByVal hfci As Long, ByVal fGetNextCab As BOOL, ByVal pfnfcignc As Long, ByVal pfnfcis As Long) As BOOL
Private Declare Function FCIDestroy CDecl Lib "cabinet.dll" (ByVal hfci As Long) As BOOL
Private Declare Function SHCreateMemStream Lib "shlwapi.dll" Alias "#12" (ByVal pInit As Long, ByVal cbInit As Long) As Long
Private Declare Function PathStripPathW Lib "shlwapi.dll" (ByVal pszPath As Long) As Long
Private Declare Function PathRemoveFileSpecW Lib "shlwapi.dll" (ByVal pszPath As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As Long) As Long
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToDosDateTime Lib "kernel32" (lpFileTime As FILETIME, lpFatDate As Integer, lpFatTime As Integer) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As BOOL
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As BOOL
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As Long, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal Addr As Long, ByRef dstValue As Long) As Long

' Constants ...
Private Const CB_MAX_DISK_NAME = 256
Private Const CB_MAX_CABINET_NAME = 256
Private Const CB_MAX_CAB_PATH = 256
Private Const OFS_MAXPATHNAME = 128
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const CREATE_ALWAYS = 2
Private Const MAX_PATH As Long = 260
Private Const tcompTYPE_MSZIP = &H1&
Private Const tcompTYPE_LZX = &H3& ' 0x0003
Private Const tcompLZX_WINDOW_LO = &HF00& ' 0x0F00
Private Const tcompLZX_WINDOW_HI = &H1500& ' 0x1500

' Types ...
Private Type TCCAB
    cb As Long ' size available for cabinet on this media
    cbFolderThresh As Long ' Thresshold for forcing a new Folder
    cbReserveCFHeader As Long ' Space to reserve in CFHEADER
    cbReserveCFFolder As Long ' Space to reserve in CFFOLDER
    cbReserveCFData As Long ' Space to reserve in CFDATA
    iCab As Long ' sequential numbers for cabinets
    iDisk As Long ' Disk number
    fFailOnIncompressible As Long ' TRUE => Fail if a block is incompressible
    setID As Integer ' Cabinet set ID
    szDisk(0 To (CB_MAX_DISK_NAME - 1)) As Byte ' current disk name
    szCab(0 To (CB_MAX_CABINET_NAME - 1)) As Byte ' current cabinet name
    szCabPath(0 To (CB_MAX_CAB_PATH - 1)) As Byte ' path for creating cabinet
End Type

Private Type TERF
    erfOper As Long
    erfType As Long
    fError As Byte
End Type

Private Type OFSTRUCT
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName(0 To (OFS_MAXPATHNAME - 1)) As Byte
End Type

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

' Variables for temporary data storage ...
Dim fh As Long
Dim fh_cab As Long
Dim cabFileName As String

' Enums ...
Private Enum BOOL
    cFalse
    cTrue
End Enum

Private Enum Stream_Seek
    STREAM_SEEK_SET
    STREAM_SEEK_CUR
    STREAM_SEEK_END
End Enum

Public Enum cabCompressionMethod
    cm_MSZIP = tcompTYPE_MSZIP
    cm_LZX15 = tcompTYPE_LZX Or tcompLZX_WINDOW_LO
    cm_LZX16 = &H1003&
    cm_LZX17 = &H1103&
    cm_LZX18 = &H1203&
    cm_LZX19 = &H1303&
    cm_LZX20 = &H1403&
    cm_LZX21 = tcompTYPE_LZX Or tcompLZX_WINDOW_HI
End Enum

' For compatibility with TwinBasic and VBA7
#If (VBA7 <> 0) Or (TWINBASIC <> 0) Then
    Private Declare PtrSafe Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
#Else
    Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
    
    Private Enum LongPtr
        [_]
    End Enum
#End If

Private Function DispCallByVtbl(ByVal pUnk As LongPtr, ByVal lIndex As Long, ParamArray A() As Variant) As Variant
    Const CC_STDCALL    As Long = 4
#If Win64 Then
    Const PTR_SIZE      As Long = 8
#Else
    Const PTR_SIZE      As Long = 4
#End If
    Dim lIdx            As Long
    Dim vParam()        As Variant
    Dim vType(0 To 63)  As Integer
    Dim vPtr(0 To 63)   As LongPtr
    Dim hResult         As Long
    
    vParam = A
    For lIdx = 0 To UBound(vParam)
        vType(lIdx) = VarType(vParam(lIdx))
        vPtr(lIdx) = VarPtr(vParam(lIdx))
    Next
    hResult = DispCallFunc(pUnk, lIndex * PTR_SIZE, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)
    If hResult < 0 Then
        Err.Raise hResult, "DispCallFunc"
    End If
End Function

Private Function IStream_Read(ByVal ptrIStream As Long, ByVal pv As Long, ByVal BytesRead As Long) As Long
    Dim BytesReaded As Long
    
    DispCallByVtbl ptrIStream, 3, pv, BytesRead, VarPtr(BytesReaded)
    IStream_Read = BytesReaded
End Function

Private Function IStream_Write(ByVal ptrIStream As Long, ByVal pv As Long, ByVal BytesWrite As Long) As Long
    Dim BytesWritten As Long
    
    DispCallByVtbl ptrIStream, 4, pv, BytesWrite, VarPtr(BytesWritten)
    IStream_Write = BytesWritten
End Function

Private Function IStream_Seek(ByVal ptrIStream As Long, ByVal Offset As Currency, ByVal Origin As Stream_Seek) As Long
    Dim NewPosition As Currency
    
    DispCallByVtbl ptrIStream, 5, Offset, Origin, VarPtr(NewPosition)
    IStream_Seek = NewPosition * 10000@
End Function

Private Sub IStream_Release(ByVal ptrIStream As Long)
    DispCallByVtbl ptrIStream, 2
End Sub

' +++ FCICreate CallBack's +++

' 1. Memory allocation
' Description of the macro: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnalloc
' Delphi: function fnAlloc(Size: ULONG): Pointer; cdecl;
Private Function fnAlloc CDecl(ByVal lngSize As Long) As Long
    fnAlloc = GlobalAlloc(0, lngSize)
End Function

' 2. Creating a temporary file (stream)
' Delphi: function fnFciGTF(pszTempName: PAnsiChar; cbTempName: Integer; pv: Pointer): BOOL; cdecl;
Private Function fnFciGTF CDecl(ByRef pszTempName As Long, ByVal cbTempName As Long, ByVal pv As Long) As BOOL
    ' Special hack:
    ' We are deceiving the operating system, which will "think" that it works with TMP files on the disk
    ' Instead of a temporary file on disk, we will create an IStream stream in the RAM of our process
    Dim hStream As Long
    
    hStream = SHCreateMemStream(0, 0) ' Create a new IStream for a temporary file
    pszTempName = hStream ' Here we will use a hack: we put the Long value in the String variable
    fnFciGTF = 1
End Function

' 3. Opening a file (stream)
' Description of the macro: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnopen
' Delphi: function fnOpen(pszFile: PAnsiChar; oflag: Integer; pmode: Integer; err: PInteger; pv: Pointer): Integer; cdecl;
Private Function fnOpen CDecl(ByRef pszFile As Long, ByVal oFlag As Long, ByVal pMode As Long, ByRef ErrNo As Long, ByVal pv As Long) As Long
    If oFlag <> &H8302& Then ' Hack
        fnOpen = pszFile
    Else
        fh_cab = CreateFileW(StrPtr(cabFileName), GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_ARCHIVE, 0)
        
        If fh_cab <> INVALID_HANDLE_VALUE Then
            ErrNo = Err.LastDllError
            fnOpen = fh_cab
        Else
            ErrNo = Err.LastDllError
            fnOpen = -1
        End If
    End If
End Function

' 4. Reading data
' Description of the macro: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnread
' Delphi: function fnRead(hf: Integer; memory: Pointer; cb: UINT; err: PInteger; pv: Pointer): UINT; cdecl;
Private Function fnRead CDecl(ByVal hf As Long, ByVal hMemory As Long, ByVal cbSize As Long, ByRef ErrNo As Long, ByVal pv As Long) As Long
    Dim dwBytesRead As Long
    
    If hf = fh Then ' If a file is opened for reading, which is added to the archive
        If ReadFile(fh, hMemory, cbSize, dwBytesRead, ByVal 0&) = cFalse Then
            ErrNo = Err.LastDllError
            fnRead = -1
            Exit Function
        End If
    Else 'If a temporary IStream is opened for reading
        dwBytesRead = IStream_Read(hf, hMemory, cbSize)
    End If
    
    fnRead = dwBytesRead
End Function

' 5. Writing data
' Description of the macro: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnwrite
' Delphi: function fnWrite(hf: Integer; memory: Pointer; cb: UINT; err: PInteger; pv: Pointer): UINT; cdecl;
Private Function fnWrite CDecl(ByVal hf As Long, ByVal hMemory As Long, ByVal cbSize As Long, ByRef ErrNo As Long, ByVal pv As Long) As Long
    Dim dwBytesWritten As Long
    
    If hf = fh_cab Then ' If an archive file is opened for recording
        If WriteFile(fh_cab, hMemory, cbSize, dwBytesWritten, ByVal 0&) = cFalse Then
            ErrNo = Err.LastDllError
            fnWrite = -1
            Exit Function
        End If
    Else ' If a temporary IStream stream is opened for writing
        dwBytesWritten = IStream_Write(hf, hMemory, cbSize)
    End If
    
    fnWrite = dwBytesWritten
End Function

' 6. Freeing up memory
' Description of the macro: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnfree
' Delphi: procedure fnFree(memory: Pointer); cdecl;
Private Sub fnFree CDecl(ByVal lngMemory As Long)
    GlobalFree lngMemory
End Sub

' 7. Positioning the pointer
' Description of the macro: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnseek
' Delphi: function fnSeek(hf: Integer; dist: Longint; seektype: Integer; err: PInteger; pv: Pointer): Longint; cdecl;
Private Function fnSeek CDecl(ByVal hf As Long, ByVal dist As Long, ByVal seektype As Long, ByRef ErrNo As Long, pv As Long) As Long
    Dim newPos As Long
    
    If hf = fh Or hf = fh_cab Then ' If a file is opened for positioning, which is added to the archive, or the archive file itself
        newPos = SetFilePointer(hf, dist, ByVal 0&, seektype)
        ErrNo = Err.LastDllError
    Else ' Positioning of the "temporary file" that is, the stream
        newPos = IStream_Seek(hf, dist / 10000@, seektype)
    End If
    
    fnSeek = newPos
End Function

' 8. Closing a file (stream)
' Description of the macro: https://learn.microsoft.com/en-us/windows/win32/api/fdi/nf-fdi-fnclose
' Delphi: function fnClose(hf: Integer; err, pv: Pointer): Integer; cdecl;
Private Function fnClose CDecl(ByVal hf As Long, ErrNo As Long, pv As Long) As Long
    If hf = fh Or hf = fh_cab Then ' If you need to close a file that is being added to the archive, or you need to close the archive file itself
        CloseHandle hf
    End If
    
    fnClose = 0
End Function

' 9. Deleting a temporary file (stream)
' Delphi: function fnDelete(pszFile: PAnsiChar; err: PInteger; pv: Pointer): Integer; cdecl;
Private Function fnDelete CDecl(ByRef pszFile As Long, ErrNo As Long, pv As Long) As Long
    IStream_Release pszFile
    fnDelete = 0
End Function

' 10. It is called every time a new file is added to the archive
' Delphi: function fnFilePlaced(var ccab: TCCAB; pszFile: PAnsiChar; cbFile: Longint; fContinuation: BOOL; pv: Pointer): THandle; cdecl;
Private Function fnFilePlaced CDecl(ccab As TCCAB, ByVal pszFile As String, ByVal FileSize As Long, ByVal fContinuation As BOOL, ByVal pv As Long) As Long
    ' Here you can get useful data:
    ' 1. FileSize
    ' 2. StrConv(ccab.szCabPath, vbUnicode)
    ' 3. StrConv(ccab.szCab, vbUnicode)
    
    fnFilePlaced = 0
End Function

' --- FCICreate CallBack's ---

' +++ FCIAddFile CallBack's +++

' 11. Setting the file attributes
' Delphi: function fnOpenInfo(pszName: PAnsiChar; var pDate: WORD; var pTime: WORD; var pAttrib: WORD; err: PInteger; pv: Pointer): Integer; cdecl;
' Syntax C++
' ;;    void FNFCIGETOPENINFO(
' ;;      [in]  LPSTR pszName,
' ;;      USHORT *pdate,
' ;;      USHORT *ptime,
' ;;      USHORT *pattribs,
' ;;      int FAR *err,
' ;;      void FAR *pv
' ;;    );
Private Function fnOpenInfo CDecl(ByVal pszName As String, pDate As Integer, pTime As Integer, pAttribs As Integer, ErrNo As Long, ByVal pv As Long) As Long
    Dim LocalTime As FILETIME
    Dim CreationTime As FILETIME
    Dim LastAccessTime As FILETIME
    Dim LastWriteTime As FILETIME
    
    pAttribs = GetFileAttributes(StrPtr(pszName))
    fh = CreateFileA(StrPtr(pszName), GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    
    If fh <> INVALID_HANDLE_VALUE Then
        GetFileTime fh, CreationTime, LastAccessTime, LastWriteTime
        FileTimeToLocalFileTime LastWriteTime, LocalTime
        FileTimeToDosDateTime LocalTime, pDate, pTime
        
        fnOpenInfo = fh
    Else
        ErrNo = Err.LastDllError
        fnOpenInfo = -1
    End If
End Function

' 12. It is called at several stages of file processing: block compression, adding a compressed block and writing an archive
' Delphi: function fnStatus(typeStatus: UINT; cb1, cb2: ULONG; pv: Pointer): Longint; cdecl;
Private Function fnStatus CDecl(ByVal typeStatus As Long, ByVal cb1 As Long, ByVal cb2 As Long, ByVal pv As Long) As Long
    fnStatus = 0
End Function

' 13. Called before creating a new archive volume
' Delphi: function fnGetNextCabinet(var ccab: TCCAB; cbPrevCab: ULONG; pv: Pointer): BOOL; cdecl;
Private Function fnGetNextCabinet CDecl(ccab As TCCAB, ByVal cbPrevCab As Long, ByVal pv As Long) As BOOL
    fnGetNextCabinet = 0
End Function

' --- FCIAddFile CallBack's ---

' To pack files into a CAB archive
' The function accepts as parameters SourceFullFileNames, DestFileNames a string (if there is one file) or an array of strings (a list of files)
' DestFileNames - this is an optional parameter, it is the path and file name inside the CAB archive
Public Function CabinetAddFiles(ByVal CabinetFullFileName As String, SourceFullFileNames As Variant, Optional DestFileNames As Variant, Optional CompressionMethod As cabCompressionMethod = cm_LZX21) As Boolean
    Dim ccab As TCCAB
    Dim erf As TERF
    Dim fci As Long
    Dim CabinetDisk As String
    Dim CabinetName As String
    Dim CabinetPath As String
    Dim AnsiSourceFileName As String
    Dim AnsiExtractFileName As String
    Dim AnsiDestinationFileName As String
    Dim AnsiSourceFullFileNames() As String
    Dim AnsiDestFileNames() As String
    Dim DestFileNamesArrayInitialized As Boolean
    Dim i As Long
    
    If Len(CabinetFullFileName) = 0 Then Exit Function
    
    If IsArray(SourceFullFileNames) Then ' If it is an array
        If CabinetIsArrayInitialized(SourceFullFileNames) = True Then ' If the array is initialized
            For i = 0 To UBound(SourceFullFileNames)
                AnsiSourceFileName = StrConv(SourceFullFileNames(i), vbFromUnicode) ' Convert to ANSI
                
                If InStrB(1, AnsiSourceFileName, ChrB(&H3F)) > 0 Then
                    ' Cabinet.dll does not support unicode file names for packaging
                    Exit Function
                End If
                
                ' We copy the array, only the resulting array will contain the file names in ANSI encoding
                CabinetInsertArrayString AnsiSourceFullFileNames, AnsiSourceFileName
            Next
        Else
            Exit Function
        End If
    Else
        If VarType(SourceFullFileNames) = vbString Then
            If SourceFullFileNames <> vbNullString Then
                AnsiSourceFileName = StrConv(SourceFullFileNames, vbFromUnicode) ' Convert to ANSI
                
                If InStrB(1, AnsiSourceFileName, ChrB(&H3F)) > 0 Then
                    ' Cabinet.dll does not support unicode file names for packaging
                    Exit Function
                End If
                
                CabinetInsertArrayString AnsiSourceFullFileNames, AnsiSourceFileName ' There will be only one row in the array
            Else ' String not be empty
                Exit Function
            End If
        Else ' Data type error (not an array or a string)
            Exit Function
        End If
    End If
    
    If IsArray(DestFileNames) Then
        If CabinetIsArrayInitialized(SourceFullFileNames) = True Then ' If the array is initialized
            If UBound(SourceFullFileNames) <> UBound(DestFileNames) Then Exit Function ' The boundaries of the arrays do not match
            
            For i = 0 To UBound(DestFileNames)
                AnsiDestinationFileName = StrConv(DestFileNames(i), vbFromUnicode) ' Convert to ANSI
                
                If InStrB(1, AnsiDestinationFileName, ChrB(&H3F)) > 0 Then
                    ' Cabinet.dll does not support unicode file names for packaging
                    Exit Function
                End If
                
                ' We copy the array, only the resulting array will contain the file names in ANSI encoding
                CabinetInsertArrayString AnsiDestFileNames, AnsiDestinationFileName
            Next
            
            DestFileNamesArrayInitialized = True
        End If
    Else
        If VarType(DestFileNames) = vbString Then
            If DestFileNames <> vbNullString Then
                AnsiDestinationFileName = StrConv(DestFileNames, vbFromUnicode) ' Convert to ANSI
                
                If InStrB(1, AnsiDestinationFileName, ChrB(&H3F)) > 0 Then
                    ' Cabinet.dll does not support unicode file names for packaging
                    Exit Function
                End If
                
                CabinetInsertArrayString AnsiDestFileNames, AnsiDestinationFileName ' There will be only one row in the array
                DestFileNamesArrayInitialized = True
            End If
        End If
    End If
    
    ' First of all, you need to take the FullFileName of the future archive and extract the folder path and file name from it
    CabinetName = StrConv(CabinetExtractFileName(CabinetFullFileName), vbFromUnicode) ' Convert to ANSI
    CabinetPath = StrConv(CabinetExtractFilePath(CabinetFullFileName), vbFromUnicode) ' Convert to ANSI
    
    ' Define structure values
    ccab.cb = &H7FFFFFFF  ' The maximum size, in bytes, of a cabinet created by FCI
    ccab.iDisk = 1
    
    CabinetDisk = StrConv("DISK1", vbFromUnicode) ' I do not know why, but it is necessary to write "DISK1"
    CopyMemory VarPtr(ccab.setID) + 2, StrPtr(CabinetDisk), LenB(CabinetDisk) ' ccab.szDisk = CabinetDisk
    CopyMemory VarPtr(ccab.setID) + 2 + 256, StrPtr(CabinetName), LenB(CabinetName) ' ccab.szCab = CabinetName
    CopyMemory VarPtr(ccab.setID) + 2 + 512, StrPtr(CabinetPath), LenB(CabinetPath) ' ccab.szCabPath = CabinetPath
    cabFileName = CabinetFullFileName ' Remember the FileName of the future archive
    
    fci = FCICreate(erf, AddressOf fnFilePlaced, AddressOf fnAlloc, AddressOf fnFree, AddressOf fnOpen, AddressOf fnRead, AddressOf fnWrite, AddressOf fnClose, AddressOf fnSeek, AddressOf fnDelete, AddressOf fnFciGTF, VarPtr(ccab))
    
    If fci <> 0 Then
        For i = 0 To UBound(AnsiSourceFullFileNames)
            AnsiSourceFileName = AnsiSourceFullFileNames(i)
            If DestFileNamesArrayInitialized = True Then
                AnsiExtractFileName = AnsiDestFileNames(i)
            Else
                If IsArray(SourceFullFileNames) Then ' If it is an array
                    AnsiExtractFileName = StrConv(CabinetExtractFileName(SourceFullFileNames(i)), vbFromUnicode) ' Convert to ANSI
                Else
                    AnsiExtractFileName = StrConv(CabinetExtractFileName(SourceFullFileNames), vbFromUnicode) ' Convert to ANSI
                End If
            End If
            
            FCIAddFile fci, StrPtr(AnsiSourceFileName), StrPtr(AnsiExtractFileName), 0, AddressOf fnGetNextCabinet, AddressOf fnStatus, AddressOf fnOpenInfo, CompressionMethod
        Next
        
        If FCIFlushCabinet(fci, cFalse, AddressOf fnGetNextCabinet, AddressOf fnStatus) = cTrue Then
            CabinetAddFiles = True
        End If
        
        FCIDestroy fci
    End If
    
    cabFileName = vbNullString
End Function