Attribute VB_Name = "modPackage"
Option Explicit

Private Const cStubResourceID = 101

Public Const PackageVersion1 = "PKG01"

Public Const cPFCompressed = 1
Public Const cPFCreatures2 = 2

Public Type PackageDefinition
    Changed As Boolean
    PackageFilename As String
    Title As String
    CompressFiles As Boolean
    Creatures2 As Boolean
    FileCount As Integer
    Files() As String
End Type

Public Type PackagedFile
    Filename As String
    Length As Long
    Data() As Byte
End Type

Public Type Package
    Version As String * 5
    Flags As Byte
    Title As String
    FileCount As Integer
    Files() As PackagedFile
End Type

Public Function LoadPackageDefinitionFile(sFilename As String, tPackageDefinition As PackageDefinition) As Boolean
    Dim nHandle As Integer
    Dim I As Integer
    Dim sLine As String
    Dim sSection As String
    Dim bProcessedLine As Boolean
    Dim sItem As String
    Dim sItemValue As String
    
    LoadPackageDefinitionFile = False
    
    nHandle = FreeFile
    
    On Error Resume Next
    
    Open sFilename For Input Access Read As #nHandle
    If Err <> 0 Then
        Exit Function
    End If
    
    On Error GoTo 0
    
    Do While Not EOF(nHandle)
        Line Input #nHandle, sLine
        
        sLine = Trim(sLine)
        bProcessedLine = False
        
        Select Case sSection
            Case "package"
                If InStr(sLine, "=") > 1 Then
                    sItem = LCase(Trim(Left(sLine, InStr(sLine, "=") - 1)))
                    sItemValue = Trim(Mid(sLine, InStr(sLine, "=") + 1))
                    Select Case sItem
                        Case "packagefilename"
                            tPackageDefinition.PackageFilename = sItemValue
                            bProcessedLine = True
                            
                        Case "title"
                            tPackageDefinition.Title = sItemValue
                            bProcessedLine = True
                            
                        Case "compressfiles"
                            tPackageDefinition.CompressFiles = CBool(sItemValue)
                            bProcessedLine = True
                            
                        Case "filecount"
                            tPackageDefinition.FileCount = CInt(sItemValue)
                            ReDim tPackageDefinition.Files(0 To tPackageDefinition.FileCount - 1)
                            bProcessedLine = True
                            
                        Case "creatures2"
                            tPackageDefinition.Creatures2 = CBool(sItemValue)
                            bProcessedLine = True
                    End Select
                End If
                
            Case "files"
                If InStr(sLine, "=") > 5 Then
                    sItem = LCase(Trim(Left(sLine, InStr(sLine, "=") - 1)))
                    sItemValue = Trim(Mid(sLine, InStr(sLine, "=") + 1))
                    If Left(sItem, 4) = "file" Then
                        If IsNumeric(Mid(sItem, 5)) Then
                            I = CInt(Mid(sItem, 5))
                            tPackageDefinition.Files(I) = sItemValue
                            bProcessedLine = True
                        End If
                    End If
                End If
        End Select
        
        If Not bProcessedLine Then
            If Left(sLine, 1) = "[" And Right(sLine, 1) = "]" Then
                sSection = LCase(Trim(Mid(sLine, 2, Len(sLine) - 2)))
            End If
        End If
    Loop
    
    Close #nHandle
    
    LoadPackageDefinitionFile = True
End Function

Public Function SavePackageDefinitionFile(sFilename As String, tPackageDefinition As PackageDefinition) As Boolean
    Dim sTempFilename As String
    Dim nHandle As Integer
    Dim I As Integer
    
    SavePackageDefinitionFile = False
    
    sTempFilename = sFilename & "~"
    
    nHandle = FreeFile
    
    On Error Resume Next
    
    Kill sTempFilename
    Err.Clear
    
    Open sTempFilename For Output Access Write As #nHandle
    If Err <> 0 Then
        Exit Function
    End If
    
    Err.Clear
    
    On Error GoTo 0
    
    Print #nHandle, "[Package]"
    If tPackageDefinition.PackageFilename <> "" Then
        Print #nHandle, "PackageFilename=" & tPackageDefinition.PackageFilename
    End If
    Print #nHandle, "Title=" & tPackageDefinition.Title
    Print #nHandle, "CompressFiles=" & tPackageDefinition.CompressFiles
    Print #nHandle, "Creatures2=" & tPackageDefinition.Creatures2
    Print #nHandle, "FileCount=" & tPackageDefinition.FileCount
    
    Print #nHandle,
    
    Print #nHandle, "[Files]"
    
    For I = 0 To tPackageDefinition.FileCount - 1
        Print #nHandle, "File" & I & "=" & tPackageDefinition.Files(I)
    Next
    
    Close #nHandle
    
    On Error Resume Next
    
    Kill sFilename
    Name sTempFilename As sFilename
    
    Err.Clear
    
    On Error GoTo 0
    
    SavePackageDefinitionFile = True
End Function

Public Function LoadPackage01(nHandle As Integer, tPackage As Package) As Boolean
    Dim nTitleLength As Byte
    
    LoadPackage01 = False
    
    Get nHandle, , tPackage.Flags
    Get nHandle, , nTitleLength
    tPackage.Title = String(nTitleLength, " ")
    Get nHandle, , tPackage.Title
    Get nHandle, , tPackage.FileCount
    ReDim tPackage.Files(0 To tPackage.FileCount - 1)
    
    Dim I As Integer
    Dim nFilenameLength As Integer
    Dim nFileLength As Long
    Dim nCompressedFileLength As Long
    Dim aCompressedFile() As Byte
    
    For I = 0 To tPackage.FileCount - 1
        Get nHandle, , nFilenameLength
        tPackage.Files(I).Filename = String(nFilenameLength, " ")
        Get nHandle, , tPackage.Files(I).Filename
        Get nHandle, , nFileLength
        tPackage.Files(I).Length = nFileLength
        If nFileLength > 0 Then
            ReDim tPackage.Files(I).Data(0 To nFileLength - 1)
            If tPackage.Flags And cPFCompressed Then
                Get nHandle, , nCompressedFileLength
                ReDim aCompressedFile(0 To nCompressedFileLength - 1)
                Get nHandle, , aCompressedFile
                
                If Not DecompressData(aCompressedFile, tPackage.Files(I).Data) Then
                    Exit Function
                End If
            Else
                Get nHandle, , tPackage.Files(I).Data
            End If
        Else
            Erase tPackage.Files(I).Data
        End If
    Next

    LoadPackage01 = True
End Function

Public Function LoadPackageFromHandle(nHandle As Integer, tPackage As Package) As Boolean
    LoadPackageFromHandle = False
    
    Get nHandle, , tPackage.Version
    
    Select Case tPackage.Version
        Case PackageVersion1
            LoadPackageFromHandle = LoadPackage01(nHandle, tPackage)
    End Select
End Function

Public Function LoadPackageFile(sFilename As String, tPackage As Package) As Boolean
    Dim nHandle As Integer
    
    LoadPackageFile = False
    
    nHandle = FreeFile
    
    On Error Resume Next
    Open sFilename For Binary Access Read As #nHandle
    If Err <> 0 Then
        Exit Function
    End If
    On Error GoTo 0
    
    LoadPackageFile = LoadPackageFromHandle(nHandle, tPackage)
    
    Close #nHandle
End Function

Public Function LoadPackageFromExe(sFilename As String, tPackage As Package) As Boolean
    Dim nHandle As Integer
    Dim nOffset As Long
    
    LoadPackageFromExe = False
    
    nHandle = FreeFile
    
    On Error Resume Next
    Open sFilename For Binary Access Read As #nHandle
    If Err <> 0 Then
        Exit Function
    End If
    On Error GoTo 0
    
    Seek #nHandle, LOF(nHandle) - 3
    
    Get nHandle, , nOffset
    
    Seek #nHandle, nOffset + 1
    
    LoadPackageFromExe = LoadPackageFromHandle(nHandle, tPackage)
    
    Close #nHandle
End Function

Public Function SavePackage01(nHandle As Integer, tPackage As Package) As Boolean
    Dim nTitleLength As Byte
    
    SavePackage01 = False
    
    nTitleLength = Len(tPackage.Title)
    
    Put nHandle, , tPackage.Flags
    Put nHandle, , nTitleLength
    Put nHandle, , tPackage.Title
    Put nHandle, , tPackage.FileCount
    
    Dim I As Integer
    Dim nFilenameLength As Integer
    Dim nFileLength As Long
    Dim nCompressedFileLength As Long
    Dim aCompressedFile() As Byte
    
    For I = 0 To tPackage.FileCount - 1
        nFilenameLength = Len(tPackage.Files(I).Filename)
        nFileLength = tPackage.Files(I).Length
        Put nHandle, , nFilenameLength
        Put nHandle, , tPackage.Files(I).Filename
        Put nHandle, , nFileLength
        If nFileLength > 0 Then
            If tPackage.Flags And cPFCompressed Then
                If Not CompressData(tPackage.Files(I).Data, aCompressedFile) Then
                    Exit Function
                End If
                nCompressedFileLength = UBound(aCompressedFile) + 1
                
                Put nHandle, , nCompressedFileLength
                Put nHandle, , aCompressedFile
            Else
                Put nHandle, , tPackage.Files(I).Data
            End If
        End If
    Next
    
    SavePackage01 = True
End Function

Public Function SavePackageToHandle(nHandle As Integer, tPackage As Package) As Boolean
    SavePackageToHandle = False
    
    Put nHandle, , tPackage.Version
    
    SavePackageToHandle = SavePackage01(nHandle, tPackage)
End Function

Public Function SavePackageFile(sFilename As String, tPackage As Package) As Boolean
    Dim sTempFilename As String
    Dim nHandle As Integer
    
    SavePackageFile = False
    
    sTempFilename = sFilename & "~"
    
    nHandle = FreeFile
    
    On Error Resume Next
    
    Kill sTempFilename
    Err.Clear
    
    Open sTempFilename For Binary Access Write As #nHandle
    If Err <> 0 Then
        Exit Function
    End If
    
    Err.Clear
    
    On Error GoTo 0
    
    If SavePackageToHandle(nHandle, tPackage) Then
        Close #nHandle
        
        On Error Resume Next
        
        Kill sFilename
        Name sTempFilename As sFilename
        
        Err.Clear
        
        On Error GoTo 0
        
        SavePackageFile = True
    Else
        Close #nHandle
        
        On Error Resume Next
        
        Kill sTempFilename
        
        Err.Clear
        
        On Error GoTo 0
    End If
End Function

Public Function PackageDefinitionRemoveFile(tPackage As PackageDefinition, Index As Integer)
    Dim I As Integer
    
    For I = Index + 1 To tPackage.FileCount - 1
        tPackage.Files(I - 1) = tPackage.Files(I)
    Next
    
    tPackage.FileCount = tPackage.FileCount - 1
    
    If tPackage.FileCount > 0 Then
    ReDim Preserve tPackage.Files(0 To tPackage.FileCount - 1)
    Else
        Erase tPackage.Files
    End If
End Function

Public Function SavePackageToExe(sFilename As String, tPackage As Package) As Boolean
    Dim sTempFilename As String
    Dim nHandle As Integer
    Dim nOffset As Long
    Dim aStubData() As Byte
    
    SavePackageToExe = False
    
    sTempFilename = sFilename & "~"
    
    nHandle = FreeFile
    
    On Error Resume Next
    
    Kill sTempFilename
    Err.Clear
    
    aStubData = LoadResData(cStubResourceID, "CUSTOM")
    
    'FileCopy App.Path & "\stub.dat", sTempFilename
    
    Open sTempFilename For Binary Access Write As #nHandle
    If Err <> 0 Then
        Exit Function
    End If
    
    Err.Clear
    
    On Error GoTo 0
    
    Put nHandle, , aStubData
    
    'nOffset = LOF(nHandle)
    'Seek #nHandle, nOffset + 1
    nOffset = Seek(nHandle) - 1
    
    If SavePackageToHandle(nHandle, tPackage) Then
        Put nHandle, , nOffset
        
        Close #nHandle
        
        On Error Resume Next
        
        Kill sFilename
        Name sTempFilename As sFilename
        
        Err.Clear
        
        On Error GoTo 0
        
        SavePackageToExe = True
    Else
        Close #nHandle
        
        On Error Resume Next
        
        Kill sTempFilename
        
        Err.Clear
        
        On Error GoTo 0
    End If
End Function

Public Function BuildPackage(tPackageDefinition As PackageDefinition, tPackage As Package) As Boolean
    BuildPackage = False
    
    tPackage.Version = PackageVersion1
    
    If tPackageDefinition.CompressFiles Then
        tPackage.Flags = tPackage.Flags Or cPFCompressed
    Else
        tPackage.Flags = tPackage.Flags And (Not cPFCompressed)
    End If
    
    If tPackageDefinition.Creatures2 Then
        tPackage.Flags = tPackage.Flags Or cPFCreatures2
    Else
        tPackage.Flags = tPackage.Flags And (Not cPFCreatures2)
    End If
    
    tPackage.Title = tPackageDefinition.Title
    tPackage.FileCount = tPackageDefinition.FileCount
    
    ReDim tPackage.Files(0 To tPackage.FileCount - 1)
    
    Dim I As Integer
    Dim J As Integer
    Dim nHandle As Integer
    
    nHandle = FreeFile
    
    For I = 0 To tPackage.FileCount - 1
        For J = Len(tPackageDefinition.Files(I)) To 1 Step -1
            If Mid(tPackageDefinition.Files(I), J, 1) = "\" Then
                Exit For
            End If
        Next
        tPackage.Files(I).Filename = Mid(tPackageDefinition.Files(I), J + 1)
        
        On Error Resume Next
        Open tPackageDefinition.Files(I) For Binary Access Read As #nHandle
        If Err <> 0 Then
            MsgBox "Could not open " & tPackageDefinition.Files(I) & " for reading!", vbOKOnly Or vbCritical, "COB Packager"
            Exit Function
        End If
        On Error GoTo 0
        
        tPackage.Files(I).Length = LOF(nHandle)
        
        If tPackage.Files(I).Length = 0 Then
            MsgBox tPackageDefinition.Files(I) & " contains no data!", vbOKOnly Or vbExclamation
        Else
            ReDim tPackage.Files(I).Data(0 To tPackage.Files(I).Length - 1)
            Get nHandle, , tPackage.Files(I).Data
        End If
        
        Close #nHandle
    Next
    
    BuildPackage = True
End Function

