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.
Code:
Option Explicit
'////////////////////////////////////////////
'// The CAB Archive packaging module //
'// Copyright (c) 21.11.2024 by HackerVlad //
'// e-mail: vladislavpeshkov@yandex.ru //
'// 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