Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Using CABINET files.

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Using CABINET files.

    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..


    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 @[email protected]
    
            '/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 ) ) = @[email protected]
    
            '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

  • #2
    Edwin --
    there is CabView sample on msdn.microsoft.com/code.
    It's also requires external DLLs ?

    ------------------

    Comment


    • #3
      Semen i wrote this before your reply;

      People are talking about compression etc.. (ZIP/RAR etc..)

      I don't know why this example is not populair.

      It's completely written with in mind that 1 exe can extract files from the cab.
      Just append the FDI.DLL as resource and extract it on demand.
      Therefore i used CALL DWORD instead of declaring the procedures.

      Maybe, just maybe, if you rename the app to extract.exe, it might even be possible to build 1 single selfextract file.
      (Is already possible in console mode)
      You need to read the doc's in the CAB-SDK.

      Hope to hear more about this..

      BTW, On my site, you can find the project with the DLL's included.

      Semen, you need a FDI for decompression or FCI.DLL for compression.
      There rather large but it is also possible to use the compiled cabinet.dll wich is only 70K.
      It contains FCI and FDI!

      But this one is pretty nasty, it consists about at least 8 callbacks.
      This one is my goal but it crashes so far.
      (Using th PB debugger)

      Link to cab-sdk is in my links section too.


      ------------------

      Comment


      • #4
        Edwin --
        Makecab is a good compressor, agree.
        I think about following.
        1) Using simple bat on own PC you make single cab (all files of distributive)
        2) Special utility crypts this file (for example, using Florent's code) and writes it to the end of your installation utility (like Jacob Gaffny).
        To be independent it possible to add also extract.exe (extrac32) - additional 40Kb is not a problem.

        Self-Exe tests password, decrypts cab (writes it to disk) and calls extract (hidden).

        [This message has been edited by Semen Matusovski (edited April 19, 2000).]

        Comment

        Working...
        X