How do I package a CAB file? On VB6 code?

**HackerVlad** · Nov 10th, 2024, 07:46 PM

Of course, I know what to do this, you need to use the FCICreate and FCIAddFile functions from the library cabinet.dll . Moreover, I understand perfectly well that these functions use the CDecl convention. However, I could not find the code for VB on the Internet. I know that this is a very complex code, but I thought maybe someone already had it written. For example, I was able to find such a code in Delphi quite calmly.

**fafalone** · Nov 10th, 2024, 08:17 PM

I actually just added these definitions to WinDevLib the other day (and just fixed to cdecl, thanks for pointing that out).

For VB6, you'll need The trick's VBCDeclFix, which lets you use both APIs and regular functions. To convert from my tB defs... Remove PtrSafe... I might have left leading underscores on some constants, just remove them (i.e. _foo to foo). Also, you have slight problem with FDISPILLFILE... VB6 will insert 2 padding bytes that shouldn't be there, so instead of the tB def, you'd need a single member of s(5) As Byte. Define LongPtr if not already defined... Public Enum LongPtr: [_]: End Enum and also BOOL... Public Enum BOOL: CFALSE: CTRUE: End Enum

For twinBASIC, just check the package reference for 'Windows Development Library for twinBASIC'.

In the tB defs, the Delegate functions are prototypes for callbacks. You'd create a regular function with the given prototype, then refer to it by AddressOf. In VB6, just comment the Public Delegate lines out (but still follow the prototypes when making the functions)

If you don't want to download and load it up in tB, you can download the package files from https://github.com/fafalone/WinDevLib
The FDI/FCI defs start on line 52,502 of wdAPI.twin in the Export\Sources folder.

ETA- Looks like they'll fit here after all if I remove the error Cause/Resolution comments...

Code:

'Cabinet API
'fdi_fcitypes.h - 100%
'fci.h - 100%
'fdi.h - 100%

Public Type ERF
    erfOper As Long ' FCI/FDI error code -- see FDIERROR_XXX
    '  and FCIERR_XXX equates for details.
    erfType As Long ' Optional error value filled in by FCI/FDI.
    ' For FCI, this is usually the C run-time
    ' *errno* value.
    fError As BOOL ' TRUE => error present
End Type

Public Const CB_MAX_CHUNK  = 32768
Public Const CB_MAX_DISK  = &H7fffffff
Public Const CB_MAX_FILENAME  = 256
Public Const CB_MAX_CABINET_NAME  = 256
Public Const CB_MAX_CAB_PATH  = 256
Public Const CB_MAX_DISK_NAME  = 256

Public Enum FdiFciTcompValues
    tcompMASK_TYPE = &H000F  ' Mask for compression type
    tcompTYPE_NONE = &H0000  ' No compression
    tcompTYPE_MSZIP = &H0001  ' MSZIP
    tcompTYPE_QUANTUM = &H0002  ' Quantum
    tcompTYPE_LZX = &H0003  ' LZX
    tcompBAD = &H000F  ' Unspecified compression type
    tcompMASK_LZX_WINDOW = &H1F00  ' Mask for LZX Compression Memory
    tcompLZX_WINDOW_LO = &H0F00  ' Lowest LZX Memory (15)
    tcompLZX_WINDOW_HI = &H1500  ' Highest LZX Memory (21)
    tcompSHIFT_LZX_WINDOW = 8  ' Amount to shift over to get int
    tcompMASK_QUANTUM_LEVEL = &H00F0  ' Mask for Quantum Compression Level
    tcompQUANTUM_LEVEL_LO = &H0010  ' Lowest Quantum Level (1)
    tcompQUANTUM_LEVEL_HI = &H0070  ' Highest Quantum Level (7)
    tcompSHIFT_QUANTUM_LEVEL = 4  ' Amount to shift over to get int
    tcompMASK_QUANTUM_MEM = &H1F00  ' Mask for Quantum Compression Memory
    tcompQUANTUM_MEM_LO = &H0A00  ' Lowest Quantum Memory (10)
    tcompQUANTUM_MEM_HI = &H1500  ' Highest Quantum Memory (21)
    tcompSHIFT_QUANTUM_MEM = 8  ' Amount to shift over to get int
    tcompMASK_RESERVED = &HE000&  ' Reserved bits (high 3 bits)
End Enum

' #define CompressionTypeFromTCOMP(tc) \
' ((tc) & tcompMASK_TYPE)
Public Function CompressionTypeFromTCOMP([TypeHint(FdiFciTcompValues)] ByVal tc As Integer) As Integer
    Return (tc) And CInt(tcompMASK_TYPE)
End Function
    

' #define CompressionLevelFromTCOMP(tc) \
' (((tc) & tcompMASK_QUANTUM_LEVEL) >> tcompSHIFT_QUANTUM_LEVEL)
Public Function CompressionLevelFromTCOMP([TypeHint(FdiFciTcompValues)] ByVal tc As Integer) As Integer
    Return (((tc) And CInt(tcompMASK_QUANTUM_LEVEL)) >> CInt(tcompSHIFT_QUANTUM_LEVEL))
End Function
    
' #define CompressionMemoryFromTCOMP(tc) \
' (((tc) & tcompMASK_QUANTUM_MEM) >> tcompSHIFT_QUANTUM_MEM)
Public Function CompressionMemoryFromTCOMP([TypeHint(FdiFciTcompValues)] ByVal tc As Integer) As Integer
   Return (((tc) And CInt(tcompMASK_QUANTUM_MEM)) >> CInt(tcompSHIFT_QUANTUM_MEM))
End Function

' #define TCOMPfromTypeLevelMemory(t,l,m)           \
' (((m) << tcompSHIFT_QUANTUM_MEM  ) |  \
 ' ((l) << tcompSHIFT_QUANTUM_LEVEL) |  \
 ' ( t                             ))
 Public Function TCOMPfromTypeLevelMemory(ByVal t As Integer, ByVal l As Integer, ByVal m As Integer) As Integer
    Return (((m) << CInt(tcompSHIFT_QUANTUM_MEM)) Or ((l) << CInt(tcompSHIFT_QUANTUM_LEVEL)) Or (t))
 End Function

' #define LZXCompressionWindowFromTCOMP(tc) \
' (((tc) & tcompMASK_LZX_WINDOW) >> tcompSHIFT_LZX_WINDOW)
Public Function LZXCompressionWindowFromTCOMP([TypeHint(FdiFciTcompValues)] ByVal tc As Integer) As Integer
    Return (((tc) And CInt(tcompMASK_LZX_WINDOW)) >> CInt(tcompSHIFT_LZX_WINDOW))
End Function
' #define TCOMPfromLZXWindow(w)      \
' (((w) << tcompSHIFT_LZX_WINDOW ) |  \
 ' ( tcompTYPE_LZX ))
Public Function TCOMPfromLZXWindow(ByVal w As Integer) As Integer
    Return (((w) << CInt(tcompSHIFT_LZX_WINDOW)) Or (CInt(tcompTYPE_LZX)))
End Function


Public Enum FCIERROR
    FCIERR_NONE ' No error
    FCIERR_OPEN_SRC ' Failure opening file to be stored in cabinet
    '   erf.erfTyp has C run-time *errno* value
    FCIERR_READ_SRC   ' Failure reading file to be stored in cabinet
    '   erf.erfTyp has C run-time *errno* value
    FCIERR_ALLOC_FAIL  ' Out of memory in FCI
    FCIERR_TEMP_FILE   ' Could not create a temporary file
    '   erf.erfTyp has C run-time *errno* value
    FCIERR_BAD_COMPR_TYPE  ' Unknown compression type
    FCIERR_CAB_FILE  ' Could not create cabinet file
    '   erf.erfTyp has C run-time *errno* value
    FCIERR_USER_ABORT  ' Client requested abort
    FCIERR_MCI_FAIL  ' Failure compressing data
    FCIERR_CAB_FORMAT_LIMIT   ' Data-size or file-count exceeded CAB format limits
    '  i.e. Total-bytes (uncompressed) in a CAB-folder exceeded 0x7FFF8000 (~ 2GB)
    '   or, CAB size (compressed) exceeded 0x7FFFFFFF
    '   or, File-count in CAB exceeded 0xFFFF
End Enum

Public Const _A_NAME_IS_UTF = &H80
Public Const _A_EXEC = &H40

Public Type CCAB
    ' longs first
    cb As Long ' size available for cabinet on this media
    cbFolderThresh As Long ' Thresshold for forcing a new Folder
    ' then ints
    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
    '#ifndef REMOVE_CHICAGO_M6_HACK
    fFailOnIncompressible As Long ' TRUE => Fail if a block is incompressible
    '#endif
    '  then shorts
    setID As Integer ' Cabinet set ID
    ' then chars
    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

' typedef void HUGE * (FAR DIAMONDAPI *PFNFCIALLOC)(ULONG cb); /* pfna */
' #define FNFCIALLOC(fn) void HUGE * FAR DIAMONDAPI fn(ULONG cb)
Public Delegate Function FciAlloc CDecl (ByVal cb As Long) As LongPtr
' typedef void (FAR DIAMONDAPI *PFNFCIFREE)(void HUGE *memory); /* pfnf */
' #define FNFCIFREE(fn) void FAR DIAMONDAPI fn(void HUGE *memory)
Public Delegate Sub FciFree CDecl (ByVal memory As LongPtr)

' typedef INT_PTR (FAR DIAMONDAPI *PFNFCIOPEN) (_In_ LPSTR pszFile, int oflag, int pmode, int FAR *err, void FAR *pv);
Public Delegate Function FciOpen CDecl (ByVal pszFile As LongPtr, ByVal oflag As Long, ByVal pmode As Long, ByVal errptr As LongPtr, ByVal pv As LongPtr) As LongPtr
' typedef UINT (FAR DIAMONDAPI *PFNFCIREAD) (INT_PTR hf, void FAR *memory, UINT cb, int FAR *err, void FAR *pv);
Public Delegate Function FciRead CDecl (ByVal hf As LongPtr, ByVal memory As LongPtr, ByVal cb As Long, ByVal errptr As LongPtr, ByVal pv As LongPtr) As Long
' typedef UINT (FAR DIAMONDAPI *PFNFCIWRITE)(INT_PTR hf, void FAR *memory, UINT cb, int FAR *err, void FAR *pv);
Public Delegate Function FciWrite CDecl (ByVal hf As LongPtr, ByVal memory As LongPtr, ByVal cb As Long, ByVal errptr As LongPtr, ByVal pv As LongPtr) As Long
' typedef int  (FAR DIAMONDAPI *PFNFCICLOSE)(INT_PTR hf, int FAR *err, void FAR *pv);
Public Delegate Function FciClose CDecl (ByVal hf As LongPtr, ByVal errptr As LongPtr, ByVal pv As LongPtr) As Long
' typedef long (FAR DIAMONDAPI *PFNFCISEEK) (INT_PTR hf, long dist, int seektype, int FAR *err, void FAR *pv);
Public Delegate Function FciSeek CDecl (ByVal hf As LongPtr, ByVal dist As Long, ByVal seektype As Long, ByVal errptr As LongPtr, ByVal pv As LongPtr) As Long
' typedef int  (FAR DIAMONDAPI *PFNFCIDELETE) (_In_ LPSTR pszFile, int FAR *err, void FAR *pv);
Public Delegate Function FciDelete CDecl (ByVal pszFile As LongPtr, ByVal errptr As LongPtr, ByVal pv As LongPtr) As Long

' #define FNFCIOPEN(fn) INT_PTR FAR DIAMONDAPI fn(_In_ LPSTR pszFile, int oflag, int pmode, int FAR *err, void FAR *pv)
' #define FNFCIREAD(fn) UINT FAR DIAMONDAPI fn(INT_PTR hf, void FAR *memory, UINT cb, int FAR *err, void FAR *pv)
' #define FNFCIWRITE(fn) UINT FAR DIAMONDAPI fn(INT_PTR hf, void FAR *memory, UINT cb, int FAR *err, void FAR *pv)
' #define FNFCICLOSE(fn) int FAR DIAMONDAPI fn(INT_PTR hf, int FAR *err, void FAR *pv)
' #define FNFCISEEK(fn) long FAR DIAMONDAPI fn(INT_PTR hf, long dist, int seektype, int FAR *err, void FAR *pv)
' #define FNFCIDELETE(fn) int FAR DIAMONDAPI fn(_In_ LPSTR pszFile, int FAR *err, void FAR *pv)

' typedef BOOL (DIAMONDAPI *PFNFCIGETNEXTCABINET)(PCCAB  pccab,
' ULONG  cbPrevCab,
' void FAR *pv); /* pfnfcignc */
Public Delegate Function FciGetNextCabinet CDecl (pccab As CCAB, ByVal cbPrevCab As Long, ByVal pv As LongPtr) As BOOL
' #define FNFCIGETNEXTCABINET(fn) BOOL DIAMONDAPI fn(PCCAB  pccab,     \
   ' ULONG  cbPrevCab, \
   ' void FAR *pv)
   
' typedef int (DIAMONDAPI *PFNFCIFILEPLACED)(PCCAB pccab,
' _In_ LPSTR pszFile,
' long  cbFile,
' BOOL  fContinuation,
' void FAR *pv); /* pfnfcifp */
Public Delegate Function FciFilePlaced CDecl (ByVal pccab As LongPtr, ByVal pszFile As LongPtr, ByVal cbFile As Long, ByVal fContinuation As BOOL, ByVal pv As LongPtr) As Long

' #define FNFCIFILEPLACED(fn) int DIAMONDAPI fn(PCCAB pccab,              \
   ' _In_ LPSTR pszFile,   \
   ' long  cbFile,             \
   ' BOOL  fContinuation,      \
   ' void FAR *pv)
   
   ' typedef INT_PTR (DIAMONDAPI *PFNFCIGETOPENINFO)(_In_ LPSTR pszName,
   ' USHORT *pdate,
   ' USHORT *ptime,
   ' USHORT *pattribs,
   ' int FAR *err,
   ' void FAR *pv); /* pfnfcigoi */
   Public Delegate Function FciGetOpenInfo CDecl (ByVal pszName As LongPtr, pdate As Integer, ptime As Integer, pattribs As Integer, ByVal errptr As LongPtr, ByVal pv As LongPtr) As LongPtr
' #define FNFCIGETOPENINFO(fn) INT_PTR DIAMONDAPI fn(_In_ LPSTR pszName,  \
      ' USHORT *pdate,    \
      ' USHORT *ptime,    \
      ' USHORT *pattribs, \
      ' int FAR *err, \
      ' void FAR *pv)

    Public Enum FciCabStatus
        statusFile = 0  ' Add File to Folder callback
        statusFolder = 1  ' Add Folder to Cabinet callback
        statusCabinet = 2  ' Write out a completed cabinet callback
    End Enum
    ' typedef long (DIAMONDAPI *PFNFCISTATUS)(UINT   typeStatus,
    ' ULONG  cb1,
    ' ULONG  cb2,
    ' void FAR *pv); /* pfnfcis */
    Public Delegate Function FciStatus CDecl (ByVal typeStatus As FciCabStatus, ByVal cb1 As Long, ByVal cb2 As Long, ByVal pv As LongPtr) As Long
' #define FNFCISTATUS(fn) long DIAMONDAPI fn(UINT   typeStatus, \
       ' ULONG  cb1,        \
       ' ULONG  cb2,        \
       ' void FAR *pv)     
       ' typedef BOOL (DIAMONDAPI *PFNFCIGETTEMPFILE)(_Out_writes_bytes_(cbTempName) char *pszTempName,
       ' _In_range_(<=, 260) int   cbTempName,
       ' void FAR *pv); /* pfnfcigtf */
    Public Delegate Function FciGetTempFile CDecl (ByVal pszTempName As LongPtr, ByVal cbTempName As Long, ByVal pv As LongPtr) As Long
' #define FNFCIGETTEMPFILE(fn) BOOL DIAMONDAPI fn(_Out_writes_bytes_(cbTempName) char *pszTempName, \
          ' _In_range_(<=, 260) int   cbTempName, \
          ' void FAR *pv)
          
    
'    Public Declare PtrSafe Function FCICreate Lib "cabinet.dll" (perf As ERF, ByVal pfnfcifp As FciFilePlaced, ByVal pfna As FciAlloc, ByVal pfnf As FciFree, ByVal pfnopen As FciOpen, ByVal pfnread As FciRead, ByVal pfnwrite As FciWrite, ByVal pfnclose As FciClose, ByVal pfnseek As FciSeek, ByVal pfndelete As FciDelete, ByVal pfnfcigtf As FciGetTempFile, pccab As CCAB, Optional ByVal pv As LongPtr) As LongPtr
'    Public Declare PtrSafe Function FCIAddFile Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal pszSourceFile As String, ByVal pszFileName As String, ByVal fExecute As BOOL, ByVal pfnfcignc As FciGetNextCabinet, ByVal pfnfcis As FciStatus, ByVal pfnfcigoi As FciGetOpenInfo, [TypeHint(FdiFciTcompValues)] ByVal typeCompress As Integer) As BOOL
'    Public Declare PtrSafe Function FCIFlushCabinet Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal fGetNextCab As BOOL, ByVal pfnfcignc As FciGetNextCabinet, ByVal pfnfcis As FciStatus) As BOOL
'    Public Declare PtrSafe Function FCIFlushFolder Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal pfnfcignc As FciGetNextCabinet, ByVal pfnfcis As FciStatus) As BOOL
Public Declare PtrSafe Function FCICreate CDecl Lib "cabinet.dll" (perf As ERF, ByVal pfnfcifp As LongPtr, ByVal pfna As LongPtr, ByVal pfnf As LongPtr, ByVal pfnopen As LongPtr, ByVal pfnread As LongPtr, ByVal pfnwrite As LongPtr, ByVal pfnclose As LongPtr, ByVal pfnseek As LongPtr, ByVal pfndelete As LongPtr, ByVal pfnfcigtf As LongPtr, pccab As CCAB, Optional ByVal pv As LongPtr) As LongPtr
Public Declare PtrSafe Function FCIAddFile CDecl Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal pszSourceFile As String, ByVal pszFileName As String, ByVal fExecute As BOOL, ByVal pfnfcignc As LongPtr, ByVal pfnfcis As LongPtr, ByVal pfnfcigoi As LongPtr, [TypeHint(FdiFciTcompValues)] ByVal typeCompress As Integer) As BOOL
Public Declare PtrSafe Function FCIFlushCabinet CDecl Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal fGetNextCab As BOOL, ByVal pfnfcignc As LongPtr, ByVal pfnfcis As LongPtr) As BOOL
Public Declare PtrSafe Function FCIFlushFolder CDecl Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal pfnfcignc As LongPtr, ByVal pfnfcis As LongPtr) As BOOL
Public Declare PtrSafe Function FCIDestroy CDecl Lib "cabinet.dll" (ByVal hfci As LongPtr) As BOOL
   
   Public Enum FDIERROR
       FDIERROR_NONE = 0
 
       FDIERROR_CABINET_NOT_FOUND = 1
 
       FDIERROR_NOT_A_CABINET = 2
 
       FDIERROR_UNKNOWN_CABINET_VERSION = 3
 
       FDIERROR_CORRUPT_CABINET = 4
 
       FDIERROR_ALLOC_FAIL = 5
 
       FDIERROR_BAD_COMPR_TYPE = 6
 
       FDIERROR_MDI_FAIL = 7
 
       FDIERROR_TARGET_FILE = 8
 
       FDIERROR_RESERVE_MISMATCH = 9
 
       FDIERROR_WRONG_CABINET = 10
 
       FDIERROR_USER_ABORT = 11
 
       FDIERROR_EOF = 12
 
   End Enum
   
   Public Type FDICABINETINFO
       cbCabinet As Long ' Total length of cabinet file
       cFolders As Integer ' Count of folders in cabinet
       cFiles As Integer ' Count of files in cabinet
       setID As Integer ' Cabinet set ID
       iCabinet As Integer ' Cabinet number in set (0 based)
       fReserve As BOOL ' TRUE => RESERVE present in cabinet
       hasprev As BOOL ' TRUE => Cabinet is chained prev
       hasnext As BOOL ' TRUE => Cabinet is chained next
   End Type
   
   Public Enum FDIDECRYPTTYPE
       fdidtNEW_CABINET = 0 ' New cabinet
       fdidtNEW_FOLDER = 1 ' New folder
       fdidtDECRYPT = 2 ' Decrypt a data block
   End Enum
   
   Public Type FDIDECRYPT
       fdidt As FDIDECRYPTTYPE ' Command type (selects union below)
       pvUser As LongPtr 'void FAR ' Decryption context
       ' union {
           ' struct {                        // fdidtNEW_CABINET
               ' void FAR *pHeaderReserve;   // RESERVE section from CFHEADER
               ' USHORT    cbHeaderReserve;  // Size of pHeaderReserve
               ' USHORT    setID;            // Cabinet set ID
               ' int       iCabinet;         // Cabinet number in set (0 based)
           ' } cabinet;

           ' struct {                        // fdidtNEW_FOLDER
               ' void FAR *pFolderReserve;   // RESERVE section from CFFOLDER
               ' USHORT    cbFolderReserve;  // Size of pFolderReserve
               ' USHORT    iFolder;          // Folder number in cabinet (0 based)
           ' } folder;

           ' struct {                        // fdidtDECRYPT
               ' void FAR *pDataReserve;     // RESERVE section from CFDATA
               ' USHORT    cbDataReserve;    // Size of pDataReserve
               ' void FAR *pbData;           // Data buffer
               ' USHORT    cbData;           // Size of data buffer
               ' BOOL      fSplit;           // TRUE if this is a split data block
               ' USHORT    cbPartial;        // 0 if this is not a split block, or
                                           ' //  the first piece of a split block;
                                           ' // Greater than 0 if this is the
                                           ' //  second piece of a split block.
           ' } decrypt;
        ' pDataReserve As LongPtr
        ' cbDataReserve As Integer
        ' pbData As LongPtr
        ' cbData As Integer
        ' fSPlit As BOOL
        ' cbPartial As Integer
        #If Win64 Then
            u(39) As Byte
        #Else
            u(23) As Byte
        #End If
   End Type
   
   ' typedef void HUGE * (FAR DIAMONDAPI *PFNALLOC)(ULONG cb); /* pfna */
    Public Delegate Function FdiAlloc (ByVal cb As Long) As LongPtr
   ' #define FNALLOC(fn) void HUGE * FAR DIAMONDAPI fn(ULONG cb)

   ' typedef void (FAR DIAMONDAPI *PFNFREE)(_In_opt_ void HUGE *pv); /* pfnf */
    Public Delegate Sub FdiFree (ByVal pv As LongPtr)
   ' #define FNFREE(fn) void FAR DIAMONDAPI fn(_In_opt_ void HUGE *pv)


   ' //** File I/O functions for FDI
   ' typedef INT_PTR (FAR DIAMONDAPI *PFNOPEN) (_In_ LPSTR pszFile, int oflag, int pmode);
    Public Delegate Function FdiOpen CDecl (ByVal pszFile As LongPtr, ByVal oflag As Long, ByVal pmode As Long) As LongPtr
   ' typedef UINT (FAR DIAMONDAPI *PFNREAD) (_In_ INT_PTR hf, _Out_writes_bytes_(cb) void FAR *pv, UINT cb);
    Public Delegate Function FdiRead CDecl (ByVal hf As LongPtr, ByVal pv As LongPtr, ByVal cb As Long) As Long
   ' typedef UINT (FAR DIAMONDAPI *PFNWRITE)(_In_ INT_PTR hf, _In_reads_bytes_(cb) void FAR *pv, UINT cb);
   Public Delegate Function FdiWrite CDecl (ByVal hf As LongPtr, ByVal pv As LongPtr, ByVal cb As Long) As Long
   ' typedef int  (FAR DIAMONDAPI *PFNCLOSE)(_In_ INT_PTR hf);
   Public Delegate Function FdiClose CDecl (ByVal hf As LongPtr) As Long
   ' typedef long (FAR DIAMONDAPI *PFNSEEK) (_In_ INT_PTR hf, long dist, int seektype);
   Public Delegate Function FdiSeek CDecl (ByVal hf As LongPtr, ByVal dist As Long, ByVal seektype As Long) As Long

   ' #define FNOPEN(fn) INT_PTR FAR DIAMONDAPI fn(_In_ LPSTR pszFile, int oflag, int pmode)
   ' #define FNREAD(fn) UINT FAR DIAMONDAPI fn(_In_ INT_PTR hf, _Out_writes_bytes_(cb) void FAR *pv, UINT cb)
   ' #define FNWRITE(fn) UINT FAR DIAMONDAPI fn(_In_ INT_PTR hf, _In_reads_bytes_(cb) void FAR *pv, UINT cb)
   ' #define FNCLOSE(fn) int FAR DIAMONDAPI fn(_In_ INT_PTR hf)
   ' #define FNSEEK(fn) long FAR DIAMONDAPI fn(_In_ INT_PTR hf, long dist, int seektype)
   
   ' typedef int (FAR DIAMONDAPI *PFNFDIDECRYPT)(PFDIDECRYPT pfdid); /* pfnfdid */
   Public Delegate Function pfnFdiDecrypt CDecl (pfdid As FDIDECRYPT) As Long
   ' #define FNFDIDECRYPT(fn) int FAR DIAMONDAPI fn(PFDIDECRYPT pfdid)
   
   Public Type FDINOTIFICATION
       ' long fields
       cb As Long
       psz1 As LongPtr 'char FAR*
       psz2 As LongPtr 'char FAR
       psz3 As LongPtr 'char FAR ' Points to a 256 character buffer
       pv As LongPtr 'void FAR ' Value for client
       ' int fields
       hf As LongPtr
       ' short fields
       date As Integer
       time As Integer
       attribs As Integer
       setID As Integer ' Cabinet set ID
       iCabinet As Integer ' Cabinet number (0-based)
       iFolder As Integer ' Folder number (0-based)
       fdie As FDIERROR
   End Type
   
   Public Enum FDINOTIFICATIONTYPE
       fdintCABINET_INFO = 0 ' General information about cabinet
       fdintPARTIAL_FILE = 1 ' First file in cabinet is continuation
       fdintCOPY_FILE = 2 ' File to be copied
       fdintCLOSE_FILE_INFO = 3 ' close the file, set relevant info
       fdintNEXT_CABINET = 4 ' File continued to next cabinet
       fdintENUMERATE = 5 ' Enumeration status
   End Enum
   
   ' typedef INT_PTR (FAR DIAMONDAPI *PFNFDINOTIFY)(FDINOTIFICATIONTYPE fdint,
   ' PFDINOTIFICATION    pfdin); /* pfnfdin */
   Public Delegate Function FdiNotify CDecl (ByVal fdint As FDINOTIFICATIONTYPE, pfdin As FDINOTIFICATION) As LongPtr
' #define FNFDINOTIFY(fn) INT_PTR FAR DIAMONDAPI fn(FDINOTIFICATIONTYPE fdint, \
      ' PFDINOTIFICATION    pfdin)
    
    #If Win64 = 0 Then
    [PackingAlignment(1)]
    #End If
    Public Type FDISPILLFILE
        ach(0 To 1) As Byte 'char ' Set to { '*', '\0' }
        cbFile As Long ' Required spill file size
    End Type
    
    Public Enum FdiCreateFlags
        cpuUNKNOWN = (-1) /* FDI does detection */
        cpu80286 = (0) /* '286 opcodes only */
        cpu80386 = (1) /* '386 opcodes used */
    End Enum
    
    ' Public Declare PtrSafe Function FDICreate Lib "cabinet.dll" (ByVal pfnalloc As FdiAlloc, ByVal pfnfree As FdiFree, ByVal pfnopen As FdiOpen, ByVal pfnread As FdiRead, ByVal pfnwrite As FdiWrite, ByVal pfnclose As FdiClose, ByVal pfnseek As FdiSeek, ByVal cpuType As FdiCreateFlags, perf As ERF) As LongPtr
    ' Public Declare PtrSafe Function FDIIsCabinet Lib "cabinet.dll" (ByVal hfdi As LongPtr, ByVal hf As LongPtr, pfdici As FDICABINETINFO) As BOOL
    ' Public Declare PtrSafe Function FDICopy Lib "cabinet.dll" (ByVal hfdi As LongPtr, ByVal pszCabinet As String, ByVal pszCabPath As String, ByVal flags As Long, ByVal pfnfdin As FdiNotify, ByVal pfnfdid As pfnFdiDecrypt, Optional ByVal pvUser As LongPtr) As BOOL
    Public Declare PtrSafe Function FDICreate CDecl Lib "cabinet.dll" (ByVal pfnalloc As LongPtr, ByVal pfnfree As LongPtr, ByVal pfnopen As LongPtr, ByVal pfnread As LongPtr, ByVal pfnwrite As LongPtr, ByVal pfnclose As LongPtr, ByVal pfnseek As LongPtr, ByVal cpuType As FdiCreateFlags, perf As ERF) As LongPtr
    Public Declare PtrSafe Function FDIIsCabinet CDecl Lib "cabinet.dll" (ByVal hfdi As LongPtr, ByVal hf As LongPtr, pfdici As FDICABINETINFO) As BOOL
    Public Declare PtrSafe Function FDICopy CDecl Lib "cabinet.dll" (ByVal hfdi As LongPtr, ByVal pszCabinet As String, ByVal pszCabPath As String, ByVal flags As Long, ByVal pfnfdin As LongPtr, ByVal pfnfdid As LongPtr, Optional ByVal pvUser As LongPtr) As BOOL
    Public Declare PtrSafe Function FDIDestroy CDecl Lib "cabinet.dll" (ByVal hfdi As LongPtr) As BOOL
    Public Declare PtrSafe Function FDITruncateCabinet CDecl Lib "cabinet.dll" (ByVal hfdi As LongPtr, ByVal pszCabinetName As String, ByVal iFolderToDelete As Integer) As BOOL

**HackerVlad** · Nov 11th, 2024, 10:26 AM

Thank you, fafalone. Also, for convenience, I suggest you add the undocumented ExtractFiles function from advpack.dll . So that you can unpack CAB-archives with just one line of code.

Code:

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

I think it would be very good if you add this feature to your library.

**fafalone** · Nov 11th, 2024, 11:13 AM

I was hesitant because of the very generic name... I know I have several project with their own ExtractFiles function. The local version would override it, but then you'd need to qualify for WinDevLib.ExtractFiles... I suppose people can just do that or use the A/W versions.

Just updated a few minutes before seeing this post so it won't be til later today or tomorrow that it appears in the package. For now:

Code:

Public Declare PtrSafe Function ExtractFilesA Lib "advpack.dll" (ByVal pszCabName As String, ByVal pszExpandDir As String, ByVal dwFlags As Long, ByVal pszFileList As String, ByVal lpReserved As LongPtr, ByVal dwReserved As Long) As Long
Public Declare PtrSafe Function ExtractFilesW Lib "advpack.dll" (ByVal pszCabName As LongPtr, ByVal pszExpandDir As LongPtr, ByVal dwFlags As Long, ByVal pszFileList As LongPtr, ByVal lpReserved As LongPtr, ByVal dwReserved As Long) As Long
Public DeclareWide PtrSafe Function ExtractFiles Lib "advpack.dll" Alias "ExtractFilesW" (ByVal pszCabName As String, ByVal pszExpandDir As String, ByVal dwFlags As Long, ByVal pszFileList As String, ByVal lpReserved As LongPtr, ByVal dwReserved As Long) As Long

(this follows the API naming patterns that are project standards... A, W, and aliased version that maps to W but can be used like A thanks to tB's DeclareWide keyword which disables Unicode<->ANSI conversion)

PS- I also added the other API you were using related to this already...

Code:

Private Type FILE_IN_CABINET_INFO_A
    NameInCabinet As String
    FileSize As Long
    Win32Error As Long
    DosDate As Integer
    DosTime As Integer
    DosAttribs As Integer
    FullTargetName(0 To (MAX_PATH - 1)) As Byte
End Type
Private Type FILE_IN_CABINET_INFO_W
    NameInCabinet As LongPtr
    FileSize As Long
    Win32Error As Long
    DosDate As Integer
    DosTime As Integer
    DosAttribs As Integer
    FullTargetName(0 To (MAX_PATH - 1)) As Integer
End Type
Private Type FILE_IN_CABINET_INFO
    NameInCabinet As LongPtr
    FileSize As Long
    Win32Error As Long
    DosDate As Integer
    DosTime As Integer
    DosAttribs As Integer
    FullTargetName(0 To (MAX_PATH - 1)) As Integer
End Type


Public Enum SpFileNotifyCodes
    SPFILENOTIFY_STARTQUEUE = &H00000001
    SPFILENOTIFY_ENDQUEUE = &H00000002
    SPFILENOTIFY_STARTSUBQUEUE = &H00000003
    SPFILENOTIFY_ENDSUBQUEUE = &H00000004
    SPFILENOTIFY_STARTDELETE = &H00000005
    SPFILENOTIFY_ENDDELETE = &H00000006
    SPFILENOTIFY_DELETEERROR = &H00000007
    SPFILENOTIFY_STARTRENAME = &H00000008
    SPFILENOTIFY_ENDRENAME = &H00000009
    SPFILENOTIFY_RENAMEERROR = &H0000000a
    SPFILENOTIFY_STARTCOPY = &H0000000b
    SPFILENOTIFY_ENDCOPY = &H0000000c
    SPFILENOTIFY_COPYERROR = &H0000000d
    SPFILENOTIFY_NEEDMEDIA = &H0000000e
    SPFILENOTIFY_QUEUESCAN = &H0000000f
'  These are used with SetupIterateCabinet().
    SPFILENOTIFY_CABINETINFO = &H00000010
    SPFILENOTIFY_FILEINCABINET = &H00000011
    SPFILENOTIFY_NEEDNEWCABINET = &H00000012
    SPFILENOTIFY_FILEEXTRACTED = &H00000013
    SPFILENOTIFY_FILEOPDELAYED = &H00000014
'  These are used for backup operations
    SPFILENOTIFY_STARTBACKUP = &H00000015
    SPFILENOTIFY_BACKUPERROR = &H00000016
    SPFILENOTIFY_ENDBACKUP = &H00000017
'  Extended notification for SetupScanFileQueue(Flags=SPQ_SCAN_USE_CALLBACKEX)
    SPFILENOTIFY_QUEUESCAN_EX = &H00000018
    SPFILENOTIFY_STARTREGISTRATION = &H00000019
    SPFILENOTIFY_ENDREGISTRATION = &H00000020
'  Extended notification for SetupScanFileQueue(Flags=SPQ_SCAN_USE_CALLBACK_SIGNERINFO)
    SPFILENOTIFY_QUEUESCAN_SIGNERINFO = &H00000040
'  Copy notification. These are bit flags that may be combined.
    SPFILENOTIFY_LANGMISMATCH = &H00010000
    SPFILENOTIFY_TARGETEXISTS = &H00020000
    SPFILENOTIFY_TARGETNEWER = &H00040000
End Enum

Public Enum SpFileOpCodes
    FILEOP_COPY = 0
    FILEOP_RENAME = 1
    FILEOP_DELETE = 2
    FILEOP_BACKUP = 3
    FILEOP_ABORT = 0
    FILEOP_DOIT = 1
    FILEOP_SKIP = 2
    FILEOP_RETRY = FILEOP_DOIT
    FILEOP_NEWPATH = 4
End Enum


' typedef UINT (CALLBACK* PSP_FILE_CALLBACK_A)(
' _In_ PVOID Context,
' _In_ UINT Notification,
' _In_ UINT_PTR Param1,
' _In_ UINT_PTR Param2
' );
Public Delegate Function SpFileCallbackA (ByVal Context As LongPtr, ByVal Notification As SpFileNotifyCodes, ByVal Param1 As LongPtr, ByVal Param2 As LongPtr) As SpFileOpCodes
' typedef UINT (CALLBACK* PSP_FILE_CALLBACK_W)(
' _In_ PVOID Context,
' _In_ UINT Notification,
' _In_ UINT_PTR Param1,
' _In_ UINT_PTR Param2
' );
Public Delegate Function SpFileCallbackW (ByVal Context As LongPtr, ByVal Notification As SpFileNotifyCodes, ByVal Param1 As LongPtr, ByVal Param2 As LongPtr) As SpFileOpCodes
Public Delegate Function SpFileCallback (ByVal Context As LongPtr, ByVal Notification As SpFileNotifyCodes, ByVal Param1 As LongPtr, ByVal Param2 As LongPtr) As SpFileOpCodes

' Public Declare PtrSafe Function SetupIterateCabinetA Lib "setupapi" (ByVal CabinetFile As String, ByVal Reserved As Long, ByVal MsgHandler As SpFileCallbackA, ByVal Context As LongPtr) As BOOL
' Public Declare PtrSafe Function SetupIterateCabinetW Lib "setupapi" (ByVal CabinetFile As LongPtr, ByVal Reserved As Long, ByVal MsgHandler As SpFileCallbackW, ByVal Context As LongPtr) As BOOL
' Public DeclareWide PtrSafe Function SetupIterateCabinet Lib "setupapi" Alias "SetupIterateCabinetW" (ByVal CabinetFile As String, ByVal Reserved As Long, ByVal MsgHandler As SpFileCallback, ByVal Context As LongPtr) As BOOL
Public Declare PtrSafe Function SetupIterateCabinetA Lib "setupapi" (ByVal CabinetFile As String, ByVal Reserved As Long, ByVal MsgHandler As LongPtr, ByVal Context As LongPtr) As BOOL
Public Declare PtrSafe Function SetupIterateCabinetW Lib "setupapi" (ByVal CabinetFile As LongPtr, ByVal Reserved As Long, ByVal MsgHandler As LongPtr, ByVal Context As LongPtr) As BOOL
Public DeclareWide PtrSafe Function SetupIterateCabinet Lib "setupapi" Alias "SetupIterateCabinetW" (ByVal CabinetFile As String, ByVal Reserved As Long, ByVal MsgHandler As LongPtr, ByVal Context As LongPtr) As BOOL

**HackerVlad** · Nov 11th, 2024, 11:26 AM

You can always rename the ExtractFiles function via Alias...

**fafalone** · Nov 11th, 2024, 02:21 PM

But then how will people know the new name?

In tB, packages are read-only: the idea is they're compiled once when the compiler starts, and isn't continuously recompiled every edit... Which in the case of WinDevLib really matters.

And yes it could be copied into the project but that's what WDL was made to avoid.

Anyway I'm adding it under the regular name.

**HackerVlad** · Nov 11th, 2024, 05:13 PM

fafalone, Are you sure that you wrote the CCAB structure correctly? See the description here: https://learn.microsoft.com/en-us/wi...ci/ns-fci-ccab
The first parameters cb, cbFolderThresh are of type ULONG. I would rather declare them as As Currency since ULONG is 8 bytes, as far as I know. I think that a simple As Long is not suitable there.

**fafalone** · Nov 11th, 2024, 05:57 PM

ULONG is 4 bytes on both 32 and 64bit.

Code:

typedef struct {
// longs first
    ULONG  cb;                  // size available for cabinet on this media
    ULONG  cbFolderThresh;      // Thresshold for forcing a new Folder

// then ints
    UINT   cbReserveCFHeader;   // Space to reserve in CFHEADER
    UINT   cbReserveCFFolder;   // Space to reserve in CFFOLDER
    UINT   cbReserveCFData;     // Space to reserve in CFDATA
    int    iCab;                // sequential numbers for cabinets
    int    iDisk;               // Disk number
#ifndef REMOVE_CHICAGO_M6_HACK
    int    fFailOnIncompressible; // TRUE => Fail if a block is incompressible
#endif

//  then shorts
    USHORT setID;               // Cabinet set ID

// then chars
    char   szDisk[CB_MAX_DISK_NAME];    // current disk name
    char   szCab[CB_MAX_CABINET_NAME];  // current cabinet name
    char   szCabPath[CB_MAX_CAB_PATH];  // path for creating cabinet
} CCAB; /* ccab */
typedef CCAB *PCCAB; /* pccab */

**HackerVlad** · Nov 11th, 2024, 06:25 PM

Sorry, and what is REMOVE_CHICAGO_M6_HACK?

**HackerVlad** · Nov 11th, 2024, 06:27 PM

I'm sorry that I thought about 8 bytes. If 4 means 4, I trust you.

**fafalone** · Nov 11th, 2024, 07:32 PM

It's definitely 4... thousands and thousands of ULONGs in the Windows SDK/WDL. No worries though, it's impossible to remember all the sizes of the billion different types in the Windows SDK. When I'm in doubt I check with a quick c++ scratch program;

Code:

#include <iostream>
#include <windows.h>
int main {
    size_t ul = sizeof(ULONG);
    std::cout
        << "sizeof(ULONG) = 0x" << std::hex << ul << '\n';
}

REMOVE_CHICAGO_M6_HACK, I have no idea. It appear nowhere else besides that line in the entire SDK and online search. So presumably it wouldn't be automatically defined anywhere (and it's not in new Windows desktop projects in VS2022), so the member should be included (#ifndef -- if *not* defined).

**couttsj** · Nov 11th, 2024, 07:45 PM

I don't understand. Why would you not use the built-in command line functions, makecab.exe, expand.exe, & extrac32.exe. Create a batch file to use these commands. To understand how to use these commands, simply add "/?" to each of them in the command mode. The exception is extrac32.exe, which requires "|more".

J.A. Coutts

**HackerVlad** · Nov 11th, 2024, 08:24 PM

couttsj, Of course, thanks for the advice, but any fool can run the EXE. And we are a community of programmers who make programs with their own hands. I know at least 2 ways to create a CAB archive using different DLLs, but I would have to drag these libraries with me, and I don't really want that. Ideally, I would create the code myself, of course, but there's a lot of fuss.

**fafalone** · Nov 11th, 2024, 10:11 PM

Originally Posted by couttsj

I don't understand. Why would you not use the built-in command line functions, makecab.exe, expand.exe, & extrac32.exe. Create a batch file to use these commands. To understand how to use these commands, simply add "/?" to each of them in the command mode. The exception is extrac32.exe, which requires "|more".

J.A. Coutts

Why not make it yourself?

Lots of people make GUI apps because they want more control, options, and information despite some command line ability to get the same end result.

**wqweto** · Nov 12th, 2024, 04:17 AM

Originally Posted by fafalone

REMOVE_CHICAGO_M6_HACK, I have no idea. It appear nowhere else besides that line in the entire SDK and online search. So presumably it wouldn't be automatically defined anywhere (and it's not in new Windows desktop projects in VS2022), so the member should be included (#ifndef -- if *not* defined).

Btw, "Chicago" is the codename of Windows 95, so obviously CAB format for Win 3.x had different memory (and probably file) header layout. "M6" probably means "method 6" i.e. very tight compression.

cheers,
</wqw>

**HackerVlad** · Nov 21st, 2024, 04:19 PM

I finally wrote a module for packaging CAB archives! But I can't insert a normal full-fledged version of my module here in the message. Therefore, so far only version 1.0, where only one file for packaging is supported (sorry, the forum does not allow me to apply more than 25 KB)

Code:

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


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 Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As Any, 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 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 tcompTYPE_MSZIP = &H1
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 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

' ?????????? ??? ?????????? ???????? ?????? ...
Dim fh As Long
Dim fh_cab As Long
Dim cabFileName As String

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

Private Enum Stream_Seek
    STREAM_SEEK_SET
    STREAM_SEEK_CUR
    STREAM_SEEK_END
End Enum

' ??? ????????????? ? TwinBasic ? 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. ????????? ??????
' ???????? ???????: 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. ???????? ?????????? ????? (??????)
' 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
    ' ??????????? ???:
    ' ?????????? ???????????? ???????, ??????? ????? "??????", ??? ???????? ? TMP-??????? ?? ?????
    ' ?????? ?????????? ????? ?? ?????, ?? ????? ????????? ????? IStream ? ??????????? ?????? ?????? ????????
    Dim hStream As Long
    
    hStream = SHCreateMemStream(0, 0) ' ??????? ????? ????? IStream ??? ?????????? ?????
    pszTempName = hStream ' ????? ?? ????? ???????????? ???: ?????????? ? ?????????? String ???????? Long
    fnFciGTF = 1
End Function

' 3. ???????? ????? (??????)
' ???????? ???????: 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 ' ???
        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. ?????? ??????
' ???????? ???????: 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 ReadFile(fh, hMemory, cbSize, dwBytesRead, ByVal 0&) = cFalse Then
            ErrNo = Err.LastDllError
            fnRead = -1
            Exit Function
        End If
    Else ' ???? ??????????? ?? ?????? ????????? ????? IStream
        dwBytesRead = IStream_Read(hf, hMemory, cbSize)
    End If
    
    fnRead = dwBytesRead
End Function

' 5. ?????? ??????
' ???????? ???????: 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 WriteFile(fh_cab, hMemory, cbSize, dwBytesWritten, ByVal 0&) = cFalse Then
            ErrNo = Err.LastDllError
            fnWrite = -1
            Exit Function
        End If
    Else ' ???? ??????????? ?? ?????? ????????? ????? IStream
        dwBytesWritten = IStream_Write(hf, hMemory, cbSize)
    End If
    
    fnWrite = dwBytesWritten
End Function

' 6. ???????????? ??????
' ???????? ???????: 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. ???????????????? ?????????
' ???????? ???????: 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 ' ???? ??????????? ?? ???????????????? ????, ??????? ??????????? ? ?????, ???? ??? ???? ??????
        newPos = SetFilePointer(hf, dist, ByVal 0&, seektype)
        ErrNo = Err.LastDllError
    Else ' ???????????????? "?????????? ?????" ?? ???? ??????
        newPos = IStream_Seek(hf, dist / 10000@, seektype)
    End If
    
    fnSeek = newPos
End Function

' 8. ???????? ????? (??????)
' ???????? ???????: 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 ' ???? ????????? ????? ????, ??????? ??????????? ? ?????, ???? ????? ????????? ??? ???? ??????
        CloseHandle hf
    End If
    
    fnClose = 0
End Function

' 9. ???????? ?????????? ????? (??????)
' 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. ?????????? ?????? ??? ??? ?????????? ?????? ????? ? ?????
' 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
    ' ????? ????? ???????? ???????? ??????:
    ' 1. FileSize
    ' 2. StrConv(ccab.szCabPath, vbUnicode)
    ' 3. StrConv(ccab.szCab, vbUnicode)
    
    fnFilePlaced = 0
End Function

' --- FCICreate CallBack's ---

' +++ FCIAddFile CallBack's +++

' 11. ????????????? ???????? ?????
' 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. ?????????? ?? ?????????? ?????? ????????? ?????: ?????? ?????, ?????????? ??????? ????? ? ?????? ??????
' 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. ?????????? ????? ????????? ?????? ???? ??????
' 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 ---

' ????????? ???? ? ????? CAB
Public Function CabinetAddFile(ByVal CabinetFullFileName As String, ByVal SourceFileName As String) 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
    
    ZeroMemory ccab, LenB(ccab)
    ZeroMemory erf, LenB(erf)
    
    ' ?????? ????? ????? ????? FullFileName ???????? ?????? ? ??????? ?? ???? ???? ? ????? ? ??? ?????
    CabinetName = StrConv(CabinetExtractFileName(CabinetFullFileName), vbFromUnicode) ' ????????????? ? ANSI
    CabinetPath = StrConv(CabinetExtractFilePath(CabinetFullFileName), vbFromUnicode) ' ????????????? ? ANSI
    
    ' ?????????? ???????? ?????????
    ccab.cb = &H7FFFFFFF ' The maximum size, in bytes, of a cabinet created by FCI
    ccab.iDisk = 1
    
    CabinetDisk = StrConv("DISK1", vbFromUnicode) ' ? ?? ???? ??????, ?? ???? ?????? "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 ' ????????? FileName ???????? ??????
    AnsiSourceFileName = StrConv(SourceFileName, vbFromUnicode) ' ????????????? ? ANSI
    AnsiExtractFileName = StrConv(CabinetExtractFileName(SourceFileName), vbFromUnicode) ' ????????????? ? ANSI
    
    If InStrB(1, AnsiSourceFileName, ChrB(&H3F)) > 0 Then
        ' Cabinet.dll ?? ???????????? ????????? ????? ?????? ??? ????????
        Exit Function
    End If
    
    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
        If FCIAddFile(fci, StrPtr(AnsiSourceFileName), StrPtr(AnsiExtractFileName), 0, AddressOf fnGetNextCabinet, AddressOf fnStatus, AddressOf fnOpenInfo, tcompTYPE_MSZIP) <> 0 Then
            If FCIFlushCabinet(fci, cFalse, AddressOf fnGetNextCabinet, AddressOf fnStatus) = cTrue Then
                CabinetAddFile = True
            End If
        End If
        
        FCIDestroy fci
    End If
    
    cabFileName = vbNullString
End Function

' ????????????? ?????? ???? ???????? ? ??? ?????
Public Function CabinetExtractFileName(ByVal FileName As String) As String
    Dim lNullPos As Long
    Dim pszPath As String
    
    pszPath = FileName
    PathStripPathW StrPtr(pszPath)
    
    lNullPos = InStr(1, pszPath, vbNullChar)
    If lNullPos Then
        CabinetExtractFileName = Left$(pszPath, lNullPos - 1)
    Else
        CabinetExtractFileName = FileName
    End If
End Function

' ????????????? ?????? ???? ???????? ? ???? ? ????? (?????? ?????????? ?? ????? "\")
Public Function CabinetExtractFilePath(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 & "\"
        CabinetExtractFilePath = pszPath
    Else
        CabinetExtractFilePath = FileName
    End If
End Function

**HackerVlad** · Nov 21st, 2024, 04:22 PM

Find the normal full-fledged version of the module for packaging CAB archives here: https://www.vbforums.com/showthread....ckaging-module

There will already be support for packing multiple files in a list at once.

**HackerVlad** · Nov 21st, 2024, 04:24 PM

https://www.cyberforum.ru/visual-bas...l#post17452537

**HackerVlad** · Nov 22nd, 2024, 04:12 AM

fafalone, by the way, you can describe all these callback functions for your library if you want.

**HackerVlad** · Nov 22nd, 2024, 07:55 AM

Originally Posted by fafalone

I actually just added these definitions to WinDevLib the other day (and just fixed to cdecl, thanks for pointing that out).

For VB6, you'll need The trick's VBCDeclFix, which lets you use both APIs and regular functions. To convert from my tB defs... Remove PtrSafe... I might have left leading underscores on some constants, just remove them (i.e. _foo to foo). Also, you have slight problem with FDISPILLFILE... VB6 will insert 2 padding bytes that shouldn't be there, so instead of the tB def, you'd need a single member of s(5) As Byte. Define LongPtr if not already defined... Public Enum LongPtr: [_]: End Enum and also BOOL... Public Enum BOOL: CFALSE: CTRUE: End Enum

For twinBASIC, just check the package reference for 'Windows Development Library for twinBASIC'.

In the tB defs, the Delegate functions are prototypes for callbacks. You'd create a regular function with the given prototype, then refer to it by AddressOf. In VB6, just comment the Public Delegate lines out (but still follow the prototypes when making the functions)

If you don't want to download and load it up in tB, you can download the package files from https://github.com/fafalone/WinDevLib
The FDI/FCI defs start on line 52,502 of wdAPI.twin in the Export\Sources folder.

ETA- Looks like they'll fit here after all if I remove the error Cause/Resolution comments...

Code:

'Cabinet API
'fdi_fcitypes.h - 100%
'fci.h - 100%
'fdi.h - 100%

Public Type ERF
    erfOper As Long ' FCI/FDI error code -- see FDIERROR_XXX
    '  and FCIERR_XXX equates for details.
    erfType As Long ' Optional error value filled in by FCI/FDI.
    ' For FCI, this is usually the C run-time
    ' *errno* value.
    fError As BOOL ' TRUE => error present
End Type

Public Const CB_MAX_CHUNK  = 32768
Public Const CB_MAX_DISK  = &H7fffffff
Public Const CB_MAX_FILENAME  = 256
Public Const CB_MAX_CABINET_NAME  = 256
Public Const CB_MAX_CAB_PATH  = 256
Public Const CB_MAX_DISK_NAME  = 256

Public Enum FdiFciTcompValues
    tcompMASK_TYPE = &H000F  ' Mask for compression type
    tcompTYPE_NONE = &H0000  ' No compression
    tcompTYPE_MSZIP = &H0001  ' MSZIP
    tcompTYPE_QUANTUM = &H0002  ' Quantum
    tcompTYPE_LZX = &H0003  ' LZX
    tcompBAD = &H000F  ' Unspecified compression type
    tcompMASK_LZX_WINDOW = &H1F00  ' Mask for LZX Compression Memory
    tcompLZX_WINDOW_LO = &H0F00  ' Lowest LZX Memory (15)
    tcompLZX_WINDOW_HI = &H1500  ' Highest LZX Memory (21)
    tcompSHIFT_LZX_WINDOW = 8  ' Amount to shift over to get int
    tcompMASK_QUANTUM_LEVEL = &H00F0  ' Mask for Quantum Compression Level
    tcompQUANTUM_LEVEL_LO = &H0010  ' Lowest Quantum Level (1)
    tcompQUANTUM_LEVEL_HI = &H0070  ' Highest Quantum Level (7)
    tcompSHIFT_QUANTUM_LEVEL = 4  ' Amount to shift over to get int
    tcompMASK_QUANTUM_MEM = &H1F00  ' Mask for Quantum Compression Memory
    tcompQUANTUM_MEM_LO = &H0A00  ' Lowest Quantum Memory (10)
    tcompQUANTUM_MEM_HI = &H1500  ' Highest Quantum Memory (21)
    tcompSHIFT_QUANTUM_MEM = 8  ' Amount to shift over to get int
    tcompMASK_RESERVED = &HE000&  ' Reserved bits (high 3 bits)
End Enum

' #define CompressionTypeFromTCOMP(tc) \
' ((tc) & tcompMASK_TYPE)
Public Function CompressionTypeFromTCOMP([TypeHint(FdiFciTcompValues)] ByVal tc As Integer) As Integer
    Return (tc) And CInt(tcompMASK_TYPE)
End Function
    

' #define CompressionLevelFromTCOMP(tc) \
' (((tc) & tcompMASK_QUANTUM_LEVEL) >> tcompSHIFT_QUANTUM_LEVEL)
Public Function CompressionLevelFromTCOMP([TypeHint(FdiFciTcompValues)] ByVal tc As Integer) As Integer
    Return (((tc) And CInt(tcompMASK_QUANTUM_LEVEL)) >> CInt(tcompSHIFT_QUANTUM_LEVEL))
End Function
    
' #define CompressionMemoryFromTCOMP(tc) \
' (((tc) & tcompMASK_QUANTUM_MEM) >> tcompSHIFT_QUANTUM_MEM)
Public Function CompressionMemoryFromTCOMP([TypeHint(FdiFciTcompValues)] ByVal tc As Integer) As Integer
   Return (((tc) And CInt(tcompMASK_QUANTUM_MEM)) >> CInt(tcompSHIFT_QUANTUM_MEM))
End Function

' #define TCOMPfromTypeLevelMemory(t,l,m)           \
' (((m) << tcompSHIFT_QUANTUM_MEM  ) |  \
 ' ((l) << tcompSHIFT_QUANTUM_LEVEL) |  \
 ' ( t                             ))
 Public Function TCOMPfromTypeLevelMemory(ByVal t As Integer, ByVal l As Integer, ByVal m As Integer) As Integer
    Return (((m) << CInt(tcompSHIFT_QUANTUM_MEM)) Or ((l) << CInt(tcompSHIFT_QUANTUM_LEVEL)) Or (t))
 End Function

' #define LZXCompressionWindowFromTCOMP(tc) \
' (((tc) & tcompMASK_LZX_WINDOW) >> tcompSHIFT_LZX_WINDOW)
Public Function LZXCompressionWindowFromTCOMP([TypeHint(FdiFciTcompValues)] ByVal tc As Integer) As Integer
    Return (((tc) And CInt(tcompMASK_LZX_WINDOW)) >> CInt(tcompSHIFT_LZX_WINDOW))
End Function
' #define TCOMPfromLZXWindow(w)      \
' (((w) << tcompSHIFT_LZX_WINDOW ) |  \
 ' ( tcompTYPE_LZX ))
Public Function TCOMPfromLZXWindow(ByVal w As Integer) As Integer
    Return (((w) << CInt(tcompSHIFT_LZX_WINDOW)) Or (CInt(tcompTYPE_LZX)))
End Function


Public Enum FCIERROR
    FCIERR_NONE ' No error
    FCIERR_OPEN_SRC ' Failure opening file to be stored in cabinet
    '   erf.erfTyp has C run-time *errno* value
    FCIERR_READ_SRC   ' Failure reading file to be stored in cabinet
    '   erf.erfTyp has C run-time *errno* value
    FCIERR_ALLOC_FAIL  ' Out of memory in FCI
    FCIERR_TEMP_FILE   ' Could not create a temporary file
    '   erf.erfTyp has C run-time *errno* value
    FCIERR_BAD_COMPR_TYPE  ' Unknown compression type
    FCIERR_CAB_FILE  ' Could not create cabinet file
    '   erf.erfTyp has C run-time *errno* value
    FCIERR_USER_ABORT  ' Client requested abort
    FCIERR_MCI_FAIL  ' Failure compressing data
    FCIERR_CAB_FORMAT_LIMIT   ' Data-size or file-count exceeded CAB format limits
    '  i.e. Total-bytes (uncompressed) in a CAB-folder exceeded 0x7FFF8000 (~ 2GB)
    '   or, CAB size (compressed) exceeded 0x7FFFFFFF
    '   or, File-count in CAB exceeded 0xFFFF
End Enum

Public Const _A_NAME_IS_UTF = &H80
Public Const _A_EXEC = &H40

Public Type CCAB
    ' longs first
    cb As Long ' size available for cabinet on this media
    cbFolderThresh As Long ' Thresshold for forcing a new Folder
    ' then ints
    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
    '#ifndef REMOVE_CHICAGO_M6_HACK
    fFailOnIncompressible As Long ' TRUE => Fail if a block is incompressible
    '#endif
    '  then shorts
    setID As Integer ' Cabinet set ID
    ' then chars
    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

' typedef void HUGE * (FAR DIAMONDAPI *PFNFCIALLOC)(ULONG cb); /* pfna */
' #define FNFCIALLOC(fn) void HUGE * FAR DIAMONDAPI fn(ULONG cb)
Public Delegate Function FciAlloc CDecl (ByVal cb As Long) As LongPtr
' typedef void (FAR DIAMONDAPI *PFNFCIFREE)(void HUGE *memory); /* pfnf */
' #define FNFCIFREE(fn) void FAR DIAMONDAPI fn(void HUGE *memory)
Public Delegate Sub FciFree CDecl (ByVal memory As LongPtr)

' typedef INT_PTR (FAR DIAMONDAPI *PFNFCIOPEN) (_In_ LPSTR pszFile, int oflag, int pmode, int FAR *err, void FAR *pv);
Public Delegate Function FciOpen CDecl (ByVal pszFile As LongPtr, ByVal oflag As Long, ByVal pmode As Long, ByVal errptr As LongPtr, ByVal pv As LongPtr) As LongPtr
' typedef UINT (FAR DIAMONDAPI *PFNFCIREAD) (INT_PTR hf, void FAR *memory, UINT cb, int FAR *err, void FAR *pv);
Public Delegate Function FciRead CDecl (ByVal hf As LongPtr, ByVal memory As LongPtr, ByVal cb As Long, ByVal errptr As LongPtr, ByVal pv As LongPtr) As Long
' typedef UINT (FAR DIAMONDAPI *PFNFCIWRITE)(INT_PTR hf, void FAR *memory, UINT cb, int FAR *err, void FAR *pv);
Public Delegate Function FciWrite CDecl (ByVal hf As LongPtr, ByVal memory As LongPtr, ByVal cb As Long, ByVal errptr As LongPtr, ByVal pv As LongPtr) As Long
' typedef int  (FAR DIAMONDAPI *PFNFCICLOSE)(INT_PTR hf, int FAR *err, void FAR *pv);
Public Delegate Function FciClose CDecl (ByVal hf As LongPtr, ByVal errptr As LongPtr, ByVal pv As LongPtr) As Long
' typedef long (FAR DIAMONDAPI *PFNFCISEEK) (INT_PTR hf, long dist, int seektype, int FAR *err, void FAR *pv);
Public Delegate Function FciSeek CDecl (ByVal hf As LongPtr, ByVal dist As Long, ByVal seektype As Long, ByVal errptr As LongPtr, ByVal pv As LongPtr) As Long
' typedef int  (FAR DIAMONDAPI *PFNFCIDELETE) (_In_ LPSTR pszFile, int FAR *err, void FAR *pv);
Public Delegate Function FciDelete CDecl (ByVal pszFile As LongPtr, ByVal errptr As LongPtr, ByVal pv As LongPtr) As Long

' #define FNFCIOPEN(fn) INT_PTR FAR DIAMONDAPI fn(_In_ LPSTR pszFile, int oflag, int pmode, int FAR *err, void FAR *pv)
' #define FNFCIREAD(fn) UINT FAR DIAMONDAPI fn(INT_PTR hf, void FAR *memory, UINT cb, int FAR *err, void FAR *pv)
' #define FNFCIWRITE(fn) UINT FAR DIAMONDAPI fn(INT_PTR hf, void FAR *memory, UINT cb, int FAR *err, void FAR *pv)
' #define FNFCICLOSE(fn) int FAR DIAMONDAPI fn(INT_PTR hf, int FAR *err, void FAR *pv)
' #define FNFCISEEK(fn) long FAR DIAMONDAPI fn(INT_PTR hf, long dist, int seektype, int FAR *err, void FAR *pv)
' #define FNFCIDELETE(fn) int FAR DIAMONDAPI fn(_In_ LPSTR pszFile, int FAR *err, void FAR *pv)

' typedef BOOL (DIAMONDAPI *PFNFCIGETNEXTCABINET)(PCCAB  pccab,
' ULONG  cbPrevCab,
' void FAR *pv); /* pfnfcignc */
Public Delegate Function FciGetNextCabinet CDecl (pccab As CCAB, ByVal cbPrevCab As Long, ByVal pv As LongPtr) As BOOL
' #define FNFCIGETNEXTCABINET(fn) BOOL DIAMONDAPI fn(PCCAB  pccab,     \
   ' ULONG  cbPrevCab, \
   ' void FAR *pv)
   
' typedef int (DIAMONDAPI *PFNFCIFILEPLACED)(PCCAB pccab,
' _In_ LPSTR pszFile,
' long  cbFile,
' BOOL  fContinuation,
' void FAR *pv); /* pfnfcifp */
Public Delegate Function FciFilePlaced CDecl (ByVal pccab As LongPtr, ByVal pszFile As LongPtr, ByVal cbFile As Long, ByVal fContinuation As BOOL, ByVal pv As LongPtr) As Long

' #define FNFCIFILEPLACED(fn) int DIAMONDAPI fn(PCCAB pccab,              \
   ' _In_ LPSTR pszFile,   \
   ' long  cbFile,             \
   ' BOOL  fContinuation,      \
   ' void FAR *pv)
   
   ' typedef INT_PTR (DIAMONDAPI *PFNFCIGETOPENINFO)(_In_ LPSTR pszName,
   ' USHORT *pdate,
   ' USHORT *ptime,
   ' USHORT *pattribs,
   ' int FAR *err,
   ' void FAR *pv); /* pfnfcigoi */
   Public Delegate Function FciGetOpenInfo CDecl (ByVal pszName As LongPtr, pdate As Integer, ptime As Integer, pattribs As Integer, ByVal errptr As LongPtr, ByVal pv As LongPtr) As LongPtr
' #define FNFCIGETOPENINFO(fn) INT_PTR DIAMONDAPI fn(_In_ LPSTR pszName,  \
      ' USHORT *pdate,    \
      ' USHORT *ptime,    \
      ' USHORT *pattribs, \
      ' int FAR *err, \
      ' void FAR *pv)

    Public Enum FciCabStatus
        statusFile = 0  ' Add File to Folder callback
        statusFolder = 1  ' Add Folder to Cabinet callback
        statusCabinet = 2  ' Write out a completed cabinet callback
    End Enum
    ' typedef long (DIAMONDAPI *PFNFCISTATUS)(UINT   typeStatus,
    ' ULONG  cb1,
    ' ULONG  cb2,
    ' void FAR *pv); /* pfnfcis */
    Public Delegate Function FciStatus CDecl (ByVal typeStatus As FciCabStatus, ByVal cb1 As Long, ByVal cb2 As Long, ByVal pv As LongPtr) As Long
' #define FNFCISTATUS(fn) long DIAMONDAPI fn(UINT   typeStatus, \
       ' ULONG  cb1,        \
       ' ULONG  cb2,        \
       ' void FAR *pv)     
       ' typedef BOOL (DIAMONDAPI *PFNFCIGETTEMPFILE)(_Out_writes_bytes_(cbTempName) char *pszTempName,
       ' _In_range_(<=, 260) int   cbTempName,
       ' void FAR *pv); /* pfnfcigtf */
    Public Delegate Function FciGetTempFile CDecl (ByVal pszTempName As LongPtr, ByVal cbTempName As Long, ByVal pv As LongPtr) As Long
' #define FNFCIGETTEMPFILE(fn) BOOL DIAMONDAPI fn(_Out_writes_bytes_(cbTempName) char *pszTempName, \
          ' _In_range_(<=, 260) int   cbTempName, \
          ' void FAR *pv)
          
    
'    Public Declare PtrSafe Function FCICreate Lib "cabinet.dll" (perf As ERF, ByVal pfnfcifp As FciFilePlaced, ByVal pfna As FciAlloc, ByVal pfnf As FciFree, ByVal pfnopen As FciOpen, ByVal pfnread As FciRead, ByVal pfnwrite As FciWrite, ByVal pfnclose As FciClose, ByVal pfnseek As FciSeek, ByVal pfndelete As FciDelete, ByVal pfnfcigtf As FciGetTempFile, pccab As CCAB, Optional ByVal pv As LongPtr) As LongPtr
'    Public Declare PtrSafe Function FCIAddFile Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal pszSourceFile As String, ByVal pszFileName As String, ByVal fExecute As BOOL, ByVal pfnfcignc As FciGetNextCabinet, ByVal pfnfcis As FciStatus, ByVal pfnfcigoi As FciGetOpenInfo, [TypeHint(FdiFciTcompValues)] ByVal typeCompress As Integer) As BOOL
'    Public Declare PtrSafe Function FCIFlushCabinet Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal fGetNextCab As BOOL, ByVal pfnfcignc As FciGetNextCabinet, ByVal pfnfcis As FciStatus) As BOOL
'    Public Declare PtrSafe Function FCIFlushFolder Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal pfnfcignc As FciGetNextCabinet, ByVal pfnfcis As FciStatus) As BOOL
Public Declare PtrSafe Function FCICreate CDecl Lib "cabinet.dll" (perf As ERF, ByVal pfnfcifp As LongPtr, ByVal pfna As LongPtr, ByVal pfnf As LongPtr, ByVal pfnopen As LongPtr, ByVal pfnread As LongPtr, ByVal pfnwrite As LongPtr, ByVal pfnclose As LongPtr, ByVal pfnseek As LongPtr, ByVal pfndelete As LongPtr, ByVal pfnfcigtf As LongPtr, pccab As CCAB, Optional ByVal pv As LongPtr) As LongPtr
Public Declare PtrSafe Function FCIAddFile CDecl Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal pszSourceFile As String, ByVal pszFileName As String, ByVal fExecute As BOOL, ByVal pfnfcignc As LongPtr, ByVal pfnfcis As LongPtr, ByVal pfnfcigoi As LongPtr, [TypeHint(FdiFciTcompValues)] ByVal typeCompress As Integer) As BOOL
Public Declare PtrSafe Function FCIFlushCabinet CDecl Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal fGetNextCab As BOOL, ByVal pfnfcignc As LongPtr, ByVal pfnfcis As LongPtr) As BOOL
Public Declare PtrSafe Function FCIFlushFolder CDecl Lib "cabinet.dll" (ByVal hfci As LongPtr, ByVal pfnfcignc As LongPtr, ByVal pfnfcis As LongPtr) As BOOL
Public Declare PtrSafe Function FCIDestroy CDecl Lib "cabinet.dll" (ByVal hfci As LongPtr) As BOOL
   
   Public Enum FDIERROR
       FDIERROR_NONE = 0
 
       FDIERROR_CABINET_NOT_FOUND = 1
 
       FDIERROR_NOT_A_CABINET = 2
 
       FDIERROR_UNKNOWN_CABINET_VERSION = 3
 
       FDIERROR_CORRUPT_CABINET = 4
 
       FDIERROR_ALLOC_FAIL = 5
 
       FDIERROR_BAD_COMPR_TYPE = 6
 
       FDIERROR_MDI_FAIL = 7
 
       FDIERROR_TARGET_FILE = 8
 
       FDIERROR_RESERVE_MISMATCH = 9
 
       FDIERROR_WRONG_CABINET = 10
 
       FDIERROR_USER_ABORT = 11
 
       FDIERROR_EOF = 12
 
   End Enum
   
   Public Type FDICABINETINFO
       cbCabinet As Long ' Total length of cabinet file
       cFolders As Integer ' Count of folders in cabinet
       cFiles As Integer ' Count of files in cabinet
       setID As Integer ' Cabinet set ID
       iCabinet As Integer ' Cabinet number in set (0 based)
       fReserve As BOOL ' TRUE => RESERVE present in cabinet
       hasprev As BOOL ' TRUE => Cabinet is chained prev
       hasnext As BOOL ' TRUE => Cabinet is chained next
   End Type
   
   Public Enum FDIDECRYPTTYPE
       fdidtNEW_CABINET = 0 ' New cabinet
       fdidtNEW_FOLDER = 1 ' New folder
       fdidtDECRYPT = 2 ' Decrypt a data block
   End Enum
   
   Public Type FDIDECRYPT
       fdidt As FDIDECRYPTTYPE ' Command type (selects union below)
       pvUser As LongPtr 'void FAR ' Decryption context
       ' union {
           ' struct {                        // fdidtNEW_CABINET
               ' void FAR *pHeaderReserve;   // RESERVE section from CFHEADER
               ' USHORT    cbHeaderReserve;  // Size of pHeaderReserve
               ' USHORT    setID;            // Cabinet set ID
               ' int       iCabinet;         // Cabinet number in set (0 based)
           ' } cabinet;

           ' struct {                        // fdidtNEW_FOLDER
               ' void FAR *pFolderReserve;   // RESERVE section from CFFOLDER
               ' USHORT    cbFolderReserve;  // Size of pFolderReserve
               ' USHORT    iFolder;          // Folder number in cabinet (0 based)
           ' } folder;

           ' struct {                        // fdidtDECRYPT
               ' void FAR *pDataReserve;     // RESERVE section from CFDATA
               ' USHORT    cbDataReserve;    // Size of pDataReserve
               ' void FAR *pbData;           // Data buffer
               ' USHORT    cbData;           // Size of data buffer
               ' BOOL      fSplit;           // TRUE if this is a split data block
               ' USHORT    cbPartial;        // 0 if this is not a split block, or
                                           ' //  the first piece of a split block;
                                           ' // Greater than 0 if this is the
                                           ' //  second piece of a split block.
           ' } decrypt;
        ' pDataReserve As LongPtr
        ' cbDataReserve As Integer
        ' pbData As LongPtr
        ' cbData As Integer
        ' fSPlit As BOOL
        ' cbPartial As Integer
        #If Win64 Then
            u(39) As Byte
        #Else
            u(23) As Byte
        #End If
   End Type
   
   ' typedef void HUGE * (FAR DIAMONDAPI *PFNALLOC)(ULONG cb); /* pfna */
    Public Delegate Function FdiAlloc (ByVal cb As Long) As LongPtr
   ' #define FNALLOC(fn) void HUGE * FAR DIAMONDAPI fn(ULONG cb)

   ' typedef void (FAR DIAMONDAPI *PFNFREE)(_In_opt_ void HUGE *pv); /* pfnf */
    Public Delegate Sub FdiFree (ByVal pv As LongPtr)
   ' #define FNFREE(fn) void FAR DIAMONDAPI fn(_In_opt_ void HUGE *pv)


   ' //** File I/O functions for FDI
   ' typedef INT_PTR (FAR DIAMONDAPI *PFNOPEN) (_In_ LPSTR pszFile, int oflag, int pmode);
    Public Delegate Function FdiOpen CDecl (ByVal pszFile As LongPtr, ByVal oflag As Long, ByVal pmode As Long) As LongPtr
   ' typedef UINT (FAR DIAMONDAPI *PFNREAD) (_In_ INT_PTR hf, _Out_writes_bytes_(cb) void FAR *pv, UINT cb);
    Public Delegate Function FdiRead CDecl (ByVal hf As LongPtr, ByVal pv As LongPtr, ByVal cb As Long) As Long
   ' typedef UINT (FAR DIAMONDAPI *PFNWRITE)(_In_ INT_PTR hf, _In_reads_bytes_(cb) void FAR *pv, UINT cb);
   Public Delegate Function FdiWrite CDecl (ByVal hf As LongPtr, ByVal pv As LongPtr, ByVal cb As Long) As Long
   ' typedef int  (FAR DIAMONDAPI *PFNCLOSE)(_In_ INT_PTR hf);
   Public Delegate Function FdiClose CDecl (ByVal hf As LongPtr) As Long
   ' typedef long (FAR DIAMONDAPI *PFNSEEK) (_In_ INT_PTR hf, long dist, int seektype);
   Public Delegate Function FdiSeek CDecl (ByVal hf As LongPtr, ByVal dist As Long, ByVal seektype As Long) As Long

   ' #define FNOPEN(fn) INT_PTR FAR DIAMONDAPI fn(_In_ LPSTR pszFile, int oflag, int pmode)
   ' #define FNREAD(fn) UINT FAR DIAMONDAPI fn(_In_ INT_PTR hf, _Out_writes_bytes_(cb) void FAR *pv, UINT cb)
   ' #define FNWRITE(fn) UINT FAR DIAMONDAPI fn(_In_ INT_PTR hf, _In_reads_bytes_(cb) void FAR *pv, UINT cb)
   ' #define FNCLOSE(fn) int FAR DIAMONDAPI fn(_In_ INT_PTR hf)
   ' #define FNSEEK(fn) long FAR DIAMONDAPI fn(_In_ INT_PTR hf, long dist, int seektype)
   
   ' typedef int (FAR DIAMONDAPI *PFNFDIDECRYPT)(PFDIDECRYPT pfdid); /* pfnfdid */
   Public Delegate Function pfnFdiDecrypt CDecl (pfdid As FDIDECRYPT) As Long
   ' #define FNFDIDECRYPT(fn) int FAR DIAMONDAPI fn(PFDIDECRYPT pfdid)
   
   Public Type FDINOTIFICATION
       ' long fields
       cb As Long
       psz1 As LongPtr 'char FAR*
       psz2 As LongPtr 'char FAR
       psz3 As LongPtr 'char FAR ' Points to a 256 character buffer
       pv As LongPtr 'void FAR ' Value for client
       ' int fields
       hf As LongPtr
       ' short fields
       date As Integer
       time As Integer
       attribs As Integer
       setID As Integer ' Cabinet set ID
       iCabinet As Integer ' Cabinet number (0-based)
       iFolder As Integer ' Folder number (0-based)
       fdie As FDIERROR
   End Type
   
   Public Enum FDINOTIFICATIONTYPE
       fdintCABINET_INFO = 0 ' General information about cabinet
       fdintPARTIAL_FILE = 1 ' First file in cabinet is continuation
       fdintCOPY_FILE = 2 ' File to be copied
       fdintCLOSE_FILE_INFO = 3 ' close the file, set relevant info
       fdintNEXT_CABINET = 4 ' File continued to next cabinet
       fdintENUMERATE = 5 ' Enumeration status
   End Enum
   
   ' typedef INT_PTR (FAR DIAMONDAPI *PFNFDINOTIFY)(FDINOTIFICATIONTYPE fdint,
   ' PFDINOTIFICATION    pfdin); /* pfnfdin */
   Public Delegate Function FdiNotify CDecl (ByVal fdint As FDINOTIFICATIONTYPE, pfdin As FDINOTIFICATION) As LongPtr
' #define FNFDINOTIFY(fn) INT_PTR FAR DIAMONDAPI fn(FDINOTIFICATIONTYPE fdint, \
      ' PFDINOTIFICATION    pfdin)
    
    #If Win64 = 0 Then
    [PackingAlignment(1)]
    #End If
    Public Type FDISPILLFILE
        ach(0 To 1) As Byte 'char ' Set to { '*', '\0' }
        cbFile As Long ' Required spill file size
    End Type
    
    Public Enum FdiCreateFlags
        cpuUNKNOWN = (-1) /* FDI does detection */
        cpu80286 = (0) /* '286 opcodes only */
        cpu80386 = (1) /* '386 opcodes used */
    End Enum
    
    ' Public Declare PtrSafe Function FDICreate Lib "cabinet.dll" (ByVal pfnalloc As FdiAlloc, ByVal pfnfree As FdiFree, ByVal pfnopen As FdiOpen, ByVal pfnread As FdiRead, ByVal pfnwrite As FdiWrite, ByVal pfnclose As FdiClose, ByVal pfnseek As FdiSeek, ByVal cpuType As FdiCreateFlags, perf As ERF) As LongPtr
    ' Public Declare PtrSafe Function FDIIsCabinet Lib "cabinet.dll" (ByVal hfdi As LongPtr, ByVal hf As LongPtr, pfdici As FDICABINETINFO) As BOOL
    ' Public Declare PtrSafe Function FDICopy Lib "cabinet.dll" (ByVal hfdi As LongPtr, ByVal pszCabinet As String, ByVal pszCabPath As String, ByVal flags As Long, ByVal pfnfdin As FdiNotify, ByVal pfnfdid As pfnFdiDecrypt, Optional ByVal pvUser As LongPtr) As BOOL
    Public Declare PtrSafe Function FDICreate CDecl Lib "cabinet.dll" (ByVal pfnalloc As LongPtr, ByVal pfnfree As LongPtr, ByVal pfnopen As LongPtr, ByVal pfnread As LongPtr, ByVal pfnwrite As LongPtr, ByVal pfnclose As LongPtr, ByVal pfnseek As LongPtr, ByVal cpuType As FdiCreateFlags, perf As ERF) As LongPtr
    Public Declare PtrSafe Function FDIIsCabinet CDecl Lib "cabinet.dll" (ByVal hfdi As LongPtr, ByVal hf As LongPtr, pfdici As FDICABINETINFO) As BOOL
    Public Declare PtrSafe Function FDICopy CDecl Lib "cabinet.dll" (ByVal hfdi As LongPtr, ByVal pszCabinet As String, ByVal pszCabPath As String, ByVal flags As Long, ByVal pfnfdin As LongPtr, ByVal pfnfdid As LongPtr, Optional ByVal pvUser As LongPtr) As BOOL
    Public Declare PtrSafe Function FDIDestroy CDecl Lib "cabinet.dll" (ByVal hfdi As LongPtr) As BOOL
    Public Declare PtrSafe Function FDITruncateCabinet CDecl Lib "cabinet.dll" (ByVal hfdi As LongPtr, ByVal pszCabinetName As String, ByVal iFolderToDelete As Integer) As BOOL

Dear fafalone

Please explain your code to me. Your TCOMPfromLZXWindow function for Twin. Explain to me why there are so many brackets? Why did you write such a large number of brackets? Why convert to an Integer? Why is this necessary? If everything works fine, I checked, and without these extra brackets.

Your code:

Code:

Public Function TCOMPfromLZXWindow(ByVal w As Integer) As Integer
    Return (((w) << CInt(tcompSHIFT_LZX_WINDOW)) Or (CInt(tcompTYPE_LZX)))
End Function

I don't like this code at all. It's just full of unnecessary parentheses.

You can write it much easier!?
Like this for example:

Code:

Public Function TCOMPfromLZXWindow2(ByVal w As Integer) As Integer
        Return (w << CInt(tcompSHIFT_LZX_WINDOW)) Or CInt(tcompTYPE_LZX)
    End Function

Or even like this:

Code:

Public Function TCOMPfromLZXWindow2(ByVal w As Integer) As Integer
        Return w << CInt(tcompSHIFT_LZX_WINDOW) Or CInt(tcompTYPE_LZX)
    End Function

And even better, like this:

Code:

Public Function TCOMPfromLZXWindow2(ByVal w As Long) As Long
        Return w << tcompSHIFT_LZX_WINDOW Or tcompTYPE_LZX
    End Function

And in all other similar functions, you also have a lot of extra brackets. Why?

**VanGoghGaming** · Nov 22nd, 2024, 09:28 AM

Parenthesis are useful to prevent easy mistakes that can creep up on you in complex expressions when you are not sure which operators have higher priority than others. It's not necessarily wrong.

**HackerVlad** · Nov 22nd, 2024, 09:38 AM

Originally Posted by VanGoghGaming

Parenthesis are useful to prevent easy mistakes that can creep up on you in complex expressions when you are not sure which operators have higher priority than others. It's not necessarily wrong.

Of course I understand that. But there are already too many brackets too many! Let fafalone explain why there are so many brackets there.

**HackerVlad** · Nov 23rd, 2024, 03:23 AM

Today I fixed some bugs in my module. Here is a new version of the CAB archive packaging project on VB6 and on Twin Basic.

Thread: How do I package a CAB file? On VB6 code?

Thread Tools

Display

How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Re: How do I package a CAB file? On VB6 code?

Posting Permissions