cbig.cls

WinBig. A file archive utility written in VB. Compression and decompression routines are LZSS. Full

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cBig"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private Const BIG_FILE_ID As String = "RBF1.23"

Private Type big_head
    cookie As String * 7
    toc_size As Long
    header_unknown As Long
End Type

Private Type toc_entry
    Crc64 As Currency
    name_size As Integer
    fill103 As Integer
    data_compressed_size As Long
    data_uncompressed_size As Long
    file_offset As Long
    timestamp As Long
    data_compressed_flag As Byte
    toc_unknown(0 To 2) As Byte
End Type

Private miFileID As Integer
Private msFilename As String
Private mbLoaded As Boolean
Private mheader As big_head
Private mtoc() As toc_entry
Private oError As cError
Private msubfuncname As String

Private Sub Class_Initialize()
    Set oError = New cError
    mbLoaded = False
    msFilename = ""
End Sub

Private Sub Class_Terminate()
    If mbLoaded Then
        Erase mtoc
        
        Close #miFileID
    End If
End Sub

Public Property Get Error() As cError
    Set Error = oError
End Property

Public Property Get Loaded() As Boolean
    Loaded = mbLoaded
End Property

Public Property Get Name() As String
    Name = msFilename
End Property

Public Function Load(filename As String) As Boolean
    On Error GoTo LocalError
    msubfuncname = "Load"
    oError.Clear
    
    Load = False
        
    If mbLoaded Then
        Exit Function
    End If
    
    mbLoaded = False
    msFilename = ""
    
    If Dir(filename) = "" Then
        oError.Number = ERROR_NUMBERS.ERR_NO_FILE
        Exit Function
    End If
    
    miFileID = FreeFile
    Open filename For Binary As miFileID
    
    Get #miFileID, , mheader

    If mheader.cookie <> BIG_FILE_ID Then
        Close #miFileID
        oError.Number = ERROR_NUMBERS.ERR_NOT_BIG
        Exit Function
    End If
    
    ReDim mtoc(0 To mheader.toc_size - 1)
    Get #miFileID, , mtoc

    mbLoaded = True
    msFilename = filename
    Load = True
    
    Exit Function
LocalError:
    oError.Number = Err.Number
    oError.Description = Err.Description
    Err.Raise oError.Number, msubfuncname, oError.Description
End Function

Public Function FindFile(Crc64 As Currency) As Long
    On Error GoTo LocalError
    msubfuncname = "FindFile"
    oError.Clear
    
    Dim llx As Long
    
    FindFile = -1
    
    If mbLoaded Then
        For llx = 0 To UBound(mtoc)
            If mtoc(llx).Crc64 = Crc64 Then
                Exit For
            End If
        Next llx
            
        If llx <= UBound(mtoc) Then
            FindFile = llx
        Else
            oError.Number = ERROR_NUMBERS.ERR_NOT_FOUND
        End If
    Else
        oError.Number = ERROR_NUMBERS.ERR_NO_BIG
    End If
    
    Exit Function
LocalError:
    oError.Number = Err.Number
    oError.Description = Err.Description
    Err.Raise oError.Number, msubfuncname, oError.Description
End Function

Public Function GetFileName(ID As Long) As String
    On Error GoTo LocalError
    msubfuncname = "GetFileName"
    oError.Clear
    
    If mbLoaded Then
        If ID < mheader.toc_size Then
            Dim Bytes() As Byte
            
            ReDim Bytes(0 To mtoc(ID).name_size - 1)
            
            Seek #miFileID, mtoc(ID).file_offset + 1
            Get #miFileID, , Bytes
            
            Call xor_run(Bytes, UBound(Bytes))
            GetFileName = Left$(StrConv(Bytes, vbUnicode), mtoc(ID).name_size)
        Else
            oError.Number = ERROR_NUMBERS.ERR_ID_RANGE
        End If
    Else
        oError.Number = ERROR_NUMBERS.ERR_NO_BIG
    End If
    
    Exit Function
LocalError:
    oError.Number = Err.Number
    oError.Description = Err.Description
    Err.Raise oError.Number, msubfuncname, oError.Description
End Function

Public Function GetFileBlob(ID As Long) As Byte()
    On Error GoTo LocalError
    msubfuncname = "GetFileBlob"
    oError.Clear
    
    If mbLoaded Then
        If ID < mheader.toc_size Then
            Dim Bytes() As Byte
            
            ReDim Bytes(0 To mtoc(ID).data_compressed_size - 1)
            
            Seek #miFileID, mtoc(ID).file_offset + mtoc(ID).name_size + 2
            Get #miFileID, , Bytes
            
            
            GetFileBlob = Bytes
        Else
            oError.Number = ERROR_NUMBERS.ERR_ID_RANGE
        End If
    Else
        oError.Number = ERROR_NUMBERS.ERR_NO_BIG
    End If
    Exit Function
LocalError:
    oError.Number = Err.Number
    oError.Description = Err.Description
    Err.Raise oError.Number, msubfuncname, oError.Description
End Function

Public Property Get FileCount()
    FileCount = mheader.toc_size
End Property

Public Property Get data_compressed_size(ID As Long) As Long
    oError.Clear
    
    If mbLoaded Then
        If ID >= 0 And ID < mheader.toc_size Then
            data_compressed_size = mtoc(ID).data_compressed_size
        Else
            oError.Number = ERROR_NUMBERS.ERR_ID_RANGE
        End If
    Else
        oError.Number = ERROR_NUMBERS.ERR_NO_BIG
    End If
End Property

Public Property Get data_uncompressed_size(ID As Long) As Long
    oError.Clear
    
    If mbLoaded Then
        If ID >= 0 And ID < mheader.toc_size Then
            data_uncompressed_size = mtoc(ID).data_uncompressed_size
        Else
            oError.Number = ERROR_NUMBERS.ERR_ID_RANGE
        End If
    Else
        oError.Number = ERROR_NUMBERS.ERR_NO_BIG
    End If
End Property

Public Property Get timestamp(ID As Long) As String
    oError.Clear
    
    If mbLoaded Then
        If ID >= 0 And ID < mheader.toc_size Then
            timestamp = DateAdd("s", mtoc(ID).timestamp, "1/1/70")
        Else
            oError.Number = ERROR_NUMBERS.ERR_ID_RANGE
        End If
    Else
        oError.Number = ERROR_NUMBERS.ERR_NO_BIG
    End If
End Property

Public Property Get data_compressed_flag(ID As Long) As Boolean
    oError.Clear
    
    If mbLoaded Then
        If ID >= 0 And ID < mheader.toc_size Then
            data_compressed_flag = CBool(mtoc(ID).data_compressed_flag)
        Else
            oError.Number = ERROR_NUMBERS.ERR_ID_RANGE
        End If
    Else
        oError.Number = ERROR_NUMBERS.ERR_NO_BIG
    End If
End Property