CAB

Beispiel  

Dim cbCached As String
Dim cbFileAnz As Long
Dim cbEntries(10000) As String
Dim cbFileLen(10000) As Long
Dim cbFilePos(10000) As Long 

Private Const CAB_FLAG_HASRESERVE = &H4

Private Type CABHeader
    Signature As String * 4
    CheckSum As Long
    FileSize As Long
    FolderCheckSum As Long
    FirstEntryOffSet As Long
    FilesCheckSum As Long
    Version As Integer
    FolderCount As Integer
    FileCount As Integer
    Flags As Integer
    SetID As Integer
    iCabinet As Integer
End Type

Private Type CABFolder
    DataFolderOffSet As Long
    CFData As Integer
    CompressionType As Integer
End Type

Private Type CABEntry
    FileSize As Long
    FileOffSetAfterDecompression As Long
    FileControlID As Integer
    FileDate As Integer
    FileTime As Integer
    FileAttributes As Integer
End Type

'---------------------------------
'Lädt alle Infos in den Speicher
'---------------------------------
Public Sub CacheCAB(CABFile As String)
    Dim cbHeader As CABHeader
    Dim cbEntry As CABEntry
    Dim cbFolder As CABFolder
    Dim cbFile As Integer
    Dim f_char As String * 1
    Dim cbExtraLen As Long
    Dim i As Integer
    cbFile = FreeFile
    Open CABFile For Binary As cbFile
        Get cbFile, 1, cbHeader
        If cbHeader.Flags = CAB_FLAG_HASRESERVE Then
            Get cbFile, , cbExtraLen
            Seek cbFile, Seek(cbFile) + cbExtraLen
        End If
        For i = 1 To cbHeader.FolderCount
            Get cbFile, , cbFolder
        Next i
        Seek cbFile, cbHeader.FirstEntryOffSet
        For i = 1 To cbHeader.FileCount
            Get cbFile, , cbEntry
            If i = 1 Then Get cbFile, , f_char
            f_char = " "
            Do
                Get cbFile, , f_char
                If f_char = Chr(0) Then Exit Do
                cbEntries(i) = cbEntries(i) + f_char
            Loop
        Next i
    Close cbFile
    cbFileAnz = cbHeader.FileCount
    cbCached = CABFile
End Sub

'---------------------------------------
'Gibt die Anzahl der Dateien im Archiv
'zurück
'---------------------------------------
Public Function GetFileCount(CABFile As String)
    If Not cbCached = CABFile Then
        CacheCAB CABFile
    End If
    GetFileCount = cbFileAnz
End Function

'----------------------------------------
'Gibt den Dateinamen der Datei "FileIndx"
'zurück
'----------------------------------------
Public Function GetEntry(CABFile As String, FileIndx As Long) As String
    If Not cbCached = CABFile Then
        CacheCAB CABFile
    End If
    GetEntry = cbEntries(FileIndx)
End Function