modmain.bas

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

Attribute VB_Name = "ModMain"
Option Explicit

Public fFrmMain As frmMain

Private moBigFile As cBig

Public Sub Main()
    Set fFrmMain = New frmMain
    
    Load fFrmMain
    
    fFrmMain.Show

    If Command > "" Then
        fFrmMain.OpenFile Command
    End If
End Sub

Public Sub ShutDown()
    Set fFrmMain = Nothing
    
    End
End Sub

Public Sub EmptyBig()
    Set moBigFile = Nothing
End Sub

Public Sub LoadBigFile(Filename As String, list As ListView)
    On Error GoTo LocalError

    Dim loli As ListItem
    Dim llx As Long
    Dim lsName As String, lsDir As String, lsType As String
    
    Set moBigFile = New cBig
    
    moBigFile.Load Filename
    
    If moBigFile.Loaded Then
        list.ListItems.Clear
        list.Sorted = False
        
        For llx = 0 To moBigFile.FileCount - 1
            lsName = moBigFile.GetFileName(llx)
            lsDir = Dot(lsName, False, "\")
            If lsDir > "" Then lsDir = lsDir + "\"
            lsName = Dot(lsName, True, "\")
            lsType = UCase(Dot(lsName, True, ".")) + " File"
            Set loli = list.ListItems.Add(, , lsName)
            loli.SubItems(1) = lsType
            loli.SubItems(2) = moBigFile.TimeStamp(llx)
            loli.SubItems(3) = Format(moBigFile.data_uncompressed_size(llx), "#,##0")
            loli.SubItems(5) = Format(moBigFile.data_compressed_size(llx), "#,##0")
            If moBigFile.data_uncompressed_size(llx) > 0 Then
                loli.SubItems(4) = Format(1 - moBigFile.data_compressed_size(llx) / moBigFile.data_uncompressed_size(llx), "00%")
            Else
                loli.SubItems(4) = "00%"
            End If
            loli.SubItems(6) = lsDir
        Next llx
        
        list.SelectedItem.Selected = False
    Else
        MsgBox "An error occurred while loading a new Big file." & vbCrLf & vbCrLf & "Error Number: " & moBigFile.Error.Number & vbCrLf & "Description: " & moBigFile.Error.Description, vbDefaultButton1, "Application Error"
    End If
    
    Exit Sub
LocalError:
    MsgBox "An error occurred while loading a new Big file." & vbCrLf & "In the Module " & Err.Source & vbCrLf & vbCrLf & "Error Number: " & Err.Number & vbCrLf & "Description: " & Err.Description, vbDefaultButton1, "Application Error"
End Sub

Public Sub ExtractFile(ExtractDir As String, Filename As String, FileDir As String)
    On Error GoTo LocalError

    Dim Crc64 As Currency, FileId As Long
    Dim InBytes() As Byte, OutBytes() As Byte
    Dim OutputFile As String, liFreeFile As Integer
    Dim ldDate As Date
    
    Crc64 = WinBigWrk.CrcString(FileDir + Filename)
    FileId = moBigFile.FindFile(Crc64)
    If FileId >= 0 Then
        ldDate = moBigFile.TimeStamp(FileId)
        InBytes = moBigFile.GetFileBlob(FileId)
        
        If moBigFile.data_compressed_flag(FileId) Then
            OutBytes = WinBigWrk.UnCompact(InBytes)
            ReDim Preserve OutBytes(0 To UBound(OutBytes) - 1)
        Else
            OutBytes = InBytes
        End If
        
        ValidateDir ExtractDir + FileDir
        OutputFile = ExtractDir + FileDir + Filename
        
        If Dir(OutputFile) <> "" Then Kill OutputFile
        liFreeFile = FreeFile()
        Open OutputFile For Binary Access Write As #liFreeFile
        Put #liFreeFile, , OutBytes
        Close liFreeFile
        
        WinBigWrk.SetTime OutputFile, ldDate
    Else
        MsgBox "An error occurred while loading a new Big file." & vbCrLf & vbCrLf & "Error Number: " & moBigFile.Error.Number & vbCrLf & "Description: " & moBigFile.Error.Description, vbDefaultButton1, "Application Error"
    End If
    
    Erase InBytes
    Erase OutBytes
    
    Exit Sub
LocalError:
    MsgBox "An error occurred while extracting a file." & vbCrLf & "In the Module " & Err.Source & vbCrLf & vbCrLf & "Error Number: " & Err.Number & vbCrLf & "Description: " & Err.Description, vbDefaultButton1, "Application Error"
End Sub

Public Function BuildBig(Filename As String, FromDir As String, pBar As ProgressBar) As Boolean
    On Error GoTo LocalError

    Dim loWrite As cBigWrite
    
    Set loWrite = New cBigWrite
    
    BuildBig = loWrite.BuildNewBig(Filename, FromDir, pBar)
    
    If loWrite.Error > 0 Then
        MsgBox "An error occurred while building a new Big file." & vbCrLf & vbCrLf & "Error Number: " & loWrite.Error.Number & vbCrLf & "Description: " & loWrite.Error.Description, vbDefaultButton1, "Application Error"
    End If
    
    Set loWrite = Nothing
    
    Exit Function
LocalError:
    MsgBox "An error occurred while building a new Big file." & vbCrLf & "In the Module " & Err.Source & vbCrLf & vbCrLf & "Error Number: " & Err.Number & vbCrLf & "Description: " & Err.Description, vbDefaultButton1, "Application Error"
End Function