This procedure (INC) does handle the compression and decompression of CAB files.
It's tested on a single CAB file only.
The FCI and FDI dll's are free for download on the VBPJ site '0598'.
The problem with the FCI dll is that it doesn't support the FCIDestroy.
I guess this is the problem of the temp files not being removed from the temp dir.
("XX..")
I have the original CAB-SDK from MS containing the FCI.LIB and FDI.LIB.
Maybe someone can be that friendly to recompile them for us/me.
I also would prefer a combined version (1 dll) + the seperated versions.
I think i will place the DLL's on my site to..
It's tested on a single CAB file only.
The FCI and FDI dll's are free for download on the VBPJ site '0598'.
The problem with the FCI dll is that it doesn't support the FCIDestroy.
I guess this is the problem of the temp files not being removed from the temp dir.
("XX..")
I have the original CAB-SDK from MS containing the FCI.LIB and FDI.LIB.
Maybe someone can be that friendly to recompile them for us/me.
I also would prefer a combined version (1 dll) + the seperated versions.
I think i will place the DLL's on my site to..
Code:
$If 0
Example to create a CAB file;
'// Load the compression library.
If FCI_LoadLib() = 0 Then Exit Function
Dim hfci As Long
hfci = FCI_Create( "c:\MyCab.cab", 500000 )
'// Error?
If hfci = 0 Then Exit Function
'// Leave the substitute empty to use the original name.
If FCI_AddFile( hfci, "c:\MYFILE.EXE", "substitute.exe", %tcompTYPE_MSZIP, 0 ) Then
'// Finito!
If FCI_Close( hfci ) Then
MsgBox "Ready!"
Else
MsgBox "Error!"
End If
End If
'// Unload the library.
FCI_FreeLib
'////////////////////////////////////////////////////
Example to decompress;
Dim T As String
'// Load the DEcompression library.
If FDI_LoadLib() = 0 Then Exit Function
'// extract example;
' FDI_Extract "c:\MyCab.cab", "c:\temp\CABTEST", 0
T = ""
For a = 1 To FDI_EnumFiles( "c:\MyCab.cab" )
T = T & Str$( a ) & ", " & CAB_FILES( a ) & $CRLF
Next a
Msgbox T
'// Unload the library.
FDI_FreeLib
$ENDIF
Type ERF
erfOpr As Long
erfType As Long
erfErr As Long
End Type
%FCIERR_NONE = 0 'No error
%FCIERR_OPEN_SRC = 1 'Failure opening file to be stored in cabinet
%FCIERR_READ_SRC = 2 'Failure reading file to be stored in cabinet
%FCIERR_ALLOC_FAIL = 3 'Out of memory in FCI
%FCIERR_TEMP_FILE = 4 'Could not create a temporary file
%FCIERR_BAD_COMPR_TYPE = 5 'Unknow compression type
%FCIERR_CAB_FILE = 6 'Could not create cabinet file
%FCIERR_USER_ABORT = 7 'Client requested abort
%FCIERR_MCI_FAIL = 8 'Failure compressing data
'//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'// FCI (compress)
'//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'// Do you want the compression part enabled?
'%NOFCI = 1
#IF NOT %DEF( %NOFCI )
%tcompTYPE_NONE = 0 'No compression
%tcompTYPE_MSZIP = 1 'MS-ZIP compression
%tcompTYPE_QUANTUM = 2 'Quantum Compression
%tcompTYPE_LZX = 3 'LZX Compression
'API calls to add files to the cab file
Declare Function CreateCabFile( CabFileName As ASCIIZ, ByVal SetID As Integer, fciErr As ERF, ByVal FolderThresholdSize As Long ) As Long
Declare Function AddFileToCab ( ByVal hfci As Long, addFileName As ASCIIZ, addFileCabName As ASCIIZ, ByVal fExecute As Long, ByVal Compressionmethod As Long, ByVal cbfn As Long ) As Long
Declare Function FlushFolder ( ByVal hfci As Long ) As Long
Declare Function FlushCabinet ( ByVal hfci As Long ) As Long
Declare Function Commit ( ByVal hfci As Long ) As Long
'// We load the libraries using LoadLibrary, PB won't start if the DLL's aren't present.
Global hFCILib As Long
'// Load the compression library. (FCI)
Function FCI_LoadLib() As Long
If hFCILib = 0 Then hFCILib = LoadLibrary( "FCI.DLL" )
FUNCTION = hFCILib
End Function
'// Required, use it to unload the lib.
Sub FCI_FreeLib()
If hFCILib Then FreeLibrary hFCILib
hFCILib = 0
End Sub
'// To add files to a cab, you need to create the cab first.
' A handle is returned, you'll need it in the other procedures.
' FolderTreshold is important concerning decompressionspeed, you can use 200000 for example.
Function FCI_Create( ByVal FileName As String, ByVal FolderTreshold As Long ) As Long
Dim fciErr As ERF
Dim hfci As Long
Dim pProc As DWORD
If hFCILib = 0 Then Exit Function
If Trim$( FileName ) = "" Then Exit Function
pProc = GetProcAddress( hFCILib, "CreateCabFile" )
If pProc = 0 Then Exit Function
Call DWORD pProc USING CreateCabFile( ByVal StrPtr( FileName ), 0, fciErr, FolderTreshold ) To hfci
If fciErr.erfErr Then Exit Function
'// Return handle to cab file.
FUNCTION = hfci
End Function
Function FCI_AddFile( _
ByVal hfci As Long _
, ByVal FileName As String _
, ByVal FileNameInCAB As String _
, ByVal CompressionType As Long _
, ByVal RunOnExtract As Long _
, ByVal pCallBack As Long _
) As Long
Dim a As Long
Dim fciErr As ERF
Dim pProc As DWORD
Dim FileNoPath As String
Dim FilePath As String
If hFCILib = 0 Then Exit Function
If hfci = 0 Then Exit Function
If Trim$( FileName ) = "" Then Exit Function
'// We need the file with full path and a filename to store.
FilePath = Trim$( FileName )
If Mid$( FilePath, 2 ,1 ) <> ":" Then
FileNoPath = CurDir$
If Right$( FileNoPath, 1 ) <> "\" Then FileNoPath = FileNoPath & "\"
ElseIf Left$( FilePath, 1 ) = "\" Then
FileNoPath = CurDir$
If Right$( FileNoPath, 1 ) <> "\" Then FileNoPath = FileNoPath & "\"
End If
FilePath = FileNoPath & FilePath
If Trim$( FileNameInCAB ) > "" Then
FileNoPath = FileNameInCAB
Else
FileNoPath = FilePath
End If
ErrClear
a = GetAttr( FilePath )
If ErrClear Then Exit Function
a = InStr( -1, FileNoPath, "\" )
If a Then FileNoPath = Mid$( FileNoPath, a + 1 )
' Msgbox FilePath & $CRLF & FileNoPath
pProc = GetProcAddress( hFCILib, "AddFileToCab" )
If pProc = 0 Then Exit Function
'// Use a default callback if no custom callback was set.
If pCallBack = 0 Then pCallBack = CodePtr( FCI_Callback )
Call DWORD pProc USING AddFileToCab( hfci, ByVal StrPtr( FilePath ), ByVal StrPtr( FileNoPath ), RunOnExtract, CompressionType, pCallBack )
If fciErr.erfErr Then Exit Function
FUNCTION = -1
End Function
'// Close the cabfile.
Function FCI_Close( hfci As Long ) As Long
Dim fciErr As ERF
Dim pProc As DWORD
If hFCILib = 0 Then Exit Function
If hfci = 0 Then Exit Function
pProc = GetProcAddress( hFCILib, "FlushCabinet" )
If pProc = 0 Then Exit Function
'Write to the cab file
Call DWORD pProc USING FlushCabinet( hfci )
'Check for errors
If fciErr.erfErr Then Exit Function
'// Handle is no longer valid.
hfci = 0
FUNCTION = -1
End Function
Function FCI_Callback( ByVal StatusType As Long, ByVal StatusInfo1 As Long, ByVal StatusInfo2 As Long ) As Integer
'Debug.Print "FCI " & StatusType, StatusInfo1, StatusInfo2
'Beep
#If 0
'This routine is called back from C dll to monitor the progress when adding files to a cab
'The status can be either 0, 1 or 2
On Error Resume Next
Select Case StatusType
Case statusFile
Case statusFolder
Case statusCabinet
End Select
#EndIf
End Function
#ENDIF
'//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'// FDI (extract)
'//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'// Do you want the DEcompression part enabled?
'%NOFDI = 1
#IF NOT %DEF( %NOFDI )
Type FDINotification
cb As Long
psz1 As ASCIIZ PTR
psz2 As ASCIIZ PTR
psz3 As ASCIIZ PTR
fdate As Long
ftime As Long
fAttribs As Long
SetID As Long
iCabinet As Long
fDie As Long 'FDIError
End Type
%fdintCABINET_INFO = 0
%fdintPARTIAL_FILE = 1
%fdintCOPY_FILE = 2
%fdintCLOSE_FILE_INFO = 3
%fdintNEXT_CABINET = 4
%fdintENUMERATE = 5
'API calls to extract files from cab file
Declare Function OpenCabFile( fdiErr As ERF ) As Long
Declare Function IsCabFile ( ByVal hfdi As Long, CabFileName As ASCIIZ ) As Long
Declare Function ExtractCab ( ByVal hfdi As Long, CabFileName As ASCIIZ, ByVal cbfn As Long, Dest_Dir As ASCIIZ ) As Long
Declare Function FDIRelease ( ByVal hfdi As Long ) As Long
'// We load the libraries using LoadLibrary, PB won't start if the DLL's aren't present.
Global hFDILib As Long
Global CAB_FILES() As ASCIIZ * %MAX_PATH + 1
'// Load the Decompression library. (FDI)
Function FDI_LoadLib() As Long
If hFDILib = 0 Then hFDILib = LoadLibrary( "FDI.DLL" )
FUNCTION = hFDILib
End Function
'// Required, use it to unload the lib.
Sub FDI_FreeLib()
If hFDILib Then FreeLibrary hFDILib
hFDILib = 0
End Sub
Function FDI_Extract( ByVal CabFileName As String, ByVal DestinationPath As String, ByVal pCallBack As Long ) As Long
Dim a As Long
Dim hfdi As Long
Dim fdiErr As ERF
Dim pProc1 As DWORD
Dim pProc2 As DWORD
Dim pProc3 As DWORD
If hFDILib = 0 Then Exit Function
If Trim$( CabFileName ) = "" Then Exit Function
pProc1 = GetProcAddress( hFDILib, "OpenCabFile" )
If pProc1 = 0 Then Exit Function
pProc2 = GetProcAddress( hFDILib, "IsCabFile" )
If pProc2 = 0 Then Exit Function
pProc3 = GetProcAddress( hFDILib, "ExtractCab" )
If pProc3 = 0 Then Exit Function
Call DWORD pProc1 USING OpenCabFile( fdiErr ) To hfdi
If hfdi = 0 Then Goto CAB_Extract_Close
Call DWORD pProc2 USING IsCabFile( hfdi, ByVal StrPtr( CabFileName ) ) To a
If a = 0 Then Goto CAB_Extract_Close
If pCallBack = 0 Then pCallBack = CodePtr( FDI_Callback )
Call DWORD pProc3 USING ExtractCab( hfdi, ByVal StrPtr( CabFileName ), pCallBack, ByVal StrPtr( DestinationPath ) ) To a
CAB_Extract_Close:
pProc1 = 0
pProc1 = GetProcAddress( hFDILib, "Release" )
If pProc1 Then Call DWORD pProc1 USING FDIRelease( hfdi )
FUNCTION = -1
End Function
Function FDI_EnumFiles( ByVal CabFileName As String ) As Long
ReDim CAB_FILES( 0 To 0 )
If FDI_Extract( CabFileName, "", CodePtr( FDI_Callback_ENUM ) ) Then
FUNCTION = UBound( CAB_FILES )
End If
End Function
Function FDI_Callback( ByVal fdint As Long, ByVal pfdin As Long ) As Long
Dim fdin As FDINotification PTR
fdin = pfdin
#IF 0
The fdint parameter may equal one of the following values;
fdintCABINET_INFO (general information about the cabinet)
, fdintPARTIAL_FILE (the first file in the cabinet is a continuation from a previous cabinet)
, fdintCOPY_FILE (asks the application if this file should be copied)
, fdintCLOSE_FILE_INFO (close the file and set file attributes, date, etc.)
, or fdintNEXT_CABINET (file continued on next cabinet).
The pfdin parameter will point to an FDINOTIFICATION structure with some or all of the fields filled out
, depending on the value of the fdint parameter.
Four of the fields are used for general data;
cb (a long integer), and psz1, psz2, and psz3 (pointers to strings)
, the meaning of which are highly dependent on the fdint value.
The pv field will be the value the application originally passed in as the pvUser parameter to FDICopy.
#ENDIF
Select Case FDINT
Case %fdintCABINET_INFO
Case %fdintPARTIAL_FILE
Case %fdintCOPY_FILE
' Msgbox @fdin.@psz1
'/extract ? use -1
FUNCTION = -1
Case %fdintCLOSE_FILE_INFO
Case %fdintNEXT_CABINET
Case %fdintENUMERATE
End Select
End Function
'// Handy procedure to enumerate the filenames only.
' The names will be stored in the CAB_FILES() array.
Function FDI_Callback_ENUM( ByVal fdint As Long, ByVal pfdin As Long ) As Long
Dim fdin As FDINotification PTR
fdin = pfdin
Select Case FDINT
Case %fdintCABINET_INFO
Case %fdintPARTIAL_FILE
Case %fdintCOPY_FILE
ReDim PRESERVE CAB_FILES( Lbound( CAB_FILES ) To Ubound( CAB_FILES ) + 1 )
CAB_FILES( Ubound( CAB_FILES ) ) = @fdin.@psz1
'Skip extracting..
FUNCTION = 0
Case %fdintCLOSE_FILE_INFO
Case %fdintNEXT_CABINET
Case %fdintENUMERATE
End Select
End Function
#ENDIF
// running example;
'PowerBasic/DLL Projectfile.
'Project : CABINET
'Created : 2000-4-16 17:34:04
$COMPILE EXE "c:\pbwork\CAB\CAB.EXE"
Option Explicit
$INCLUDE "c:\pbdll60\winapi\win32api.inc"
Function WinMain ( ByVal hCurInstance As Long, _
ByVal hPrevInstance As Long, _
lpszCmdLine As ASCIIZ PTR, _
ByVal nCmdShow As Long ) As Long
Dim a As Long
Dim T As String
#IF NOT %DEF( %NOFCI )
MsgBox Str$( FCI_LoadLib )
Dim hCabFile As Long
hCabFile = FCI_Create( "c:\mycab.cab", 0 )
If FCI_AddFile( hCabFile, "C:\WINDOWS\EXPLORER.EXE", "", %tcompTYPE_MSZIP, 0, 0 ) Then
End If
If FCI_AddFile( hCabFile, "C:\WINDOWS\CALC.EXE", "CALCULATOR.EXE", %tcompTYPE_MSZIP, 0, 0 ) Then
End If
If FCI_Close( hCabFile ) Then
MsgBox "Ready!"
Else
MsgBox "Error!"
End If
FCI_FreeLib
#ENDIF
#IF NOT %DEF( %NOFDI )
Msgbox Str$( FDI_LoadLib )
' FDI_Extract "c:\mycab.cab", "c:\temp\CABTEST", 0
T = ""
For a = 1 To FDI_EnumFiles( "c:\mycab.cab" )
T = T & Str$( a ) & ", " & CAB_FILES( a ) & $CRLF
Next a
Msgbox T
FDI_FreeLib
#ENDIF
End Function
Comment