GRP

Allgemeiner Aufbau  

Header
Header	String * 12
FileCount	Long
Informationen zu den Daten
Entry	String * 12
FileLen	Long
Datenblock
Datenblock	Enthält die Daten der im Archiv gespeicherten Dateien

Weitere Informationen  

Beispiel  

Option Explicit

Dim grHeader As String * 12
Dim grFileCount As Long
Dim grEntry As String * 12
Dim grFileLen As Long
Dim grEntries(0 To 5000) As String * 12
Dim grPos(0 To 5000) As Long
Dim grLen(0 To 5000) As Long
Dim grCached As String

'---------------------------------------
'Gibt die Anzahl der Dateien im Archiv
'zurück
'---------------------------------------
Public Function GetFileCount(GRPFile As String) As Long
    Dim grFile As Integer
    grFile = FreeFile
    Open GRPFile For Binary As grFile
        Get grFile, 1, grHeader
        If Not grHeader = "KenSilverman" Then
            GetFileCount = -1
            Exit Function
        End If
        Get grFile, , grFileCount
    Close grFile
    GetFileCount = grFileCount
End Function 

'---------------------------------
'Lädt alle Infos in den Speicher
'---------------------------------
Public Sub CacheGRP(GRPFile As String)
    Dim grFile As Integer
    Dim i As Long
    grFile = FreeFile
    Open GRPFile For Binary As grFile
        Get grFile, 1, grHeader
        Get grFile, , grFileCount
        Do Until i = grFileCount
            Get grFile, , grEntries(i)
            Get grFile, , grLen(i)
            i = i + 1
        Loop
        i& = 1
        grPos(0) = Seek(grFile)
        Do Until i = grFileCount
            grPos(i) = grPos(i - 1) + grLen(i - 1)
            i = i + 1
        Loop
    Close grFile
    grCached = GRPFile
End Sub 

'----------------------------------------
'Gibt den Dateinamen der Datei "FileIndx"
'zurück
'----------------------------------------
Public Function GetEntry(GRPFile As String, _ 
     FileIndx As Integer) As String
    If Not grCached = GRPFile Then
        CacheGRP GRPFile
    End If
    GetEntry = grEntries(FileIndx)
End Function

'---------------------------------------
'Extrahiert eine Datei aus dem Archiv
'---------------------------------------
Public Function ExtractFile(GRPFile As String, _ 
    FileIndx As Integer, Optional DestFile As String) As Boolean
    Dim FileData As String
    Dim grFile As Integer
    Dim DestFileNr As Integer
    grFile = FreeFile
    Open GRPFile For Binary As grFile
        DestFileNr = FreeFile
        FileData = Space(grLen(FileIndx))
        Get grFile, grPos(FileIndx), FileData
        If DestFile = "" Then DestFile = RTrim(grEntries(FileIndx))
        Open DestFile For Binary As DestFileNr
            Put DestFileNr, , FileData
        Close DestFileNr
    Close grFile
End Function