Attribute VB_Name = "modCOBFunctions"
Option Explicit

Public Type COBType
    nCOBVersion As Integer
    nQuantityAvailable As Integer
    nQuantityUsed As Long
    nExpirationDay As Long
    nExpirationMonth As Long
    nExpirationYear As Long
    nNumberOfObjectScripts As Integer
    nNumberOfInstallScripts As Integer
    aObjectScripts() As String
    aInstallScripts() As String
    nPicWidth As Long
    nPicHeight As Long
    nPicUnknown As Integer
    aPicture() As Byte
    sCOBName As String
    oPicture As Bitmap
End Type

Public Enum C2RequiredFileTypeConstants
    rftcSprite = 0
    rftcSound = 1
End Enum

Public Type C2RequiredFile
    nType As Integer
    sName As String
End Type

Public Type C2AgentType
    nQuantityAvailable As Integer
    nLastInjectedTime As Long
    nInjectionDelay As Long
    nUseByDay As Byte
    nUseByMonth As Byte
    nUseByYear As Integer
    nReserved1 As Long
    nReserved2 As Long
    nReserved3 As Long
    sCOBName As String
    sCOBDescription As String
    sInjectionScript As String
    sRemoverScript As String
    nNumberOfObjectScripts As Integer
    aObjectScripts() As String
    nNumberOfRequiredFiles As Integer
    aRequiredFiles() As C2RequiredFile
    nPicWidth As Integer
    nPicHeight As Integer
    aPicture() As Byte
    oPicture As Bitmap
    'bChanged As Boolean
End Type

Public Type C2AuthType
    nDay As Byte
    nMonth As Byte
    nYear As Integer
    nVersion As Byte
    nRevision As Byte
    sName As String
    sEmail As String
    sURL As String
    sComments As String
End Type

Public Type C2EmbeddedFileType
    nType As Integer
    nReserved As Long
    nFileLength As Long
    sName As String
    aFileData() As Byte
End Type

Public Enum CreaturesVersionConstants
    cvcCreatures1 = 1
    cvcCreatures2 = 2
End Enum

Public Enum COBTypeContstants
    ctcCreatures1 = 1
    ctcCreatures2 = 2
End Enum

Public Const sC2COBTag = "cob2"
Public Const sC2AgentTag = "agnt"
Public Const sC2AuthTag = "auth"
Public Const sC2FileTag = "file"

Public Const sCreatures1RegistryKey = "SOFTWARE\Millennium Interactive\Creatures\1.0"
Public Const sCreatures2RegistryKey = "SOFTWARE\Cyberlife Technology\Creatures 2\1.0"
Public Const sBoBCoBRegistryKey = "SOFTWARE\BoBWare\BoBCoB\1.x"
Public Const sCreatures1PatchRegistryKey = "SOFTWARE\Millennium Interactive\Creatures\Patch"

Public Const sLoadCOBFilter = "All Object Files (*.bob;*.cob;*.rcb)|*.bob;*.cob;*.rcb|BOB Files (*.bob)|*.bob|COB Files (*.cob)|*.cob|RCB Files (*.rcb)|*.rcb|All Files (*.*)|*.*"
Public Const sSaveCOBFilter = "BOB Files (*.bob)|*.bob|COB Files (*.cob)|*.cob|Compressed COB Files (*.cob.gz)|*.cob.gz|RCB Files (*.rcb)|*.rcb|All Files (*.*)|*.*"
Public Const sEmbeddableFilesFilter = "All Embeddable Files (*.s16;*.wav)|*.s16;*.wav|Sprite Files (*.s16)|*.s16|Sound Files (*.wav)|*.wav"
Public Const sCOSFilter = "COS files (*.cos)|*.cos|All Files (*.*)|*.*"

Public g_bC1Installed As Boolean
Public g_bC2Installed As Boolean
Public sC1MainPath As String
Public sC1LauncherPath As String
Public sC2MainPath As String
Public sC2SoundPath As String
Public sC2ImagePath As String
Public bCommandLineInterfaceAlwaysOnTop As Boolean
Public nCreaturesVersion As CreaturesVersionConstants
Public g_sDefaultLoadFolder As String
Public g_sDefaultSaveFolder As String
Public g_sCurrentLoadFolder As String
Public g_sCurrentSaveFolder As String
Public nScriptEditorTabSize As Integer
Public sScriptEditorFontName As String
Public nScriptEditorFontSize As Integer
Public nScriptEditorLeft As Long
Public nScriptEditorTop As Long
Public nScriptEditorWidth As Long
Public nScriptEditorHeight As Long
Public bScriptEditorMaximised As Boolean

Public sCOBFilename As String
Public tCurrentCOB As New COB
Public g_oMRUFiles As New MRUFiles

Public Sub GetBoBCoBSettings()
    Dim oFileType As New FileType
    Dim oRegKey As New RegistryKey
    Dim bSuccess As Boolean
    
    'Settings common to all BoBCoB tools
    GetCommonSettings
    
    'Check BOB filetype registration
    bSuccess = oFileType.Load("bob")
    If Not bSuccess Or oFileType.Name <> "BoBCoB.BOB" Then
        oFileType.Name = "BoBCoB.BOB"
        oFileType.Description = "BoBCoB Object File"
        oFileType.DefaultIcon = App.Path & "\" & App.EXEName & ".exe,0"
        oFileType.ClearShellCommands
        oFileType.AddShellCommand "Open", App.Path & "\" & App.EXEName & ".exe -loadcob %1", True
    End If
    
    'BoBCoB specific settings
    If oRegKey.OpenKey(HKEY_CURRENT_USER, sBoBCoBRegistryKey, True) Then
        'Get Command Line Always On Top setting
        Dim sCLIAlwaysOnTop As String
        
        If oRegKey.GetKeyValue("CLIAlwaysOnTop", REG_SZ, sCLIAlwaysOnTop) Then
            bCommandLineInterfaceAlwaysOnTop = CBool(sCLIAlwaysOnTop)
        Else
            bCommandLineInterfaceAlwaysOnTop = False
        End If
        
        'Get ScriptEditorTabSize setting
        Dim sScriptEditorTabSize As String
        
        If oRegKey.GetKeyValue("ScriptEditorTabSize", REG_SZ, sScriptEditorTabSize) Then
            nScriptEditorTabSize = CLng(sScriptEditorTabSize)
        Else
            nScriptEditorTabSize = 4
        End If
        
        'Get ScriptEditorFontName setting
        If oRegKey.GetKeyValue("ScriptEditorFontName", REG_SZ, sScriptEditorFontName) Then
            sScriptEditorFontName = sScriptEditorFontName
        Else
            sScriptEditorFontName = "Courier New"
        End If
        
        'Get ScriptEditorFontSize setting
        Dim sScriptEditorFontSize As String
        
        If oRegKey.GetKeyValue("ScriptEditorFontSize", REG_SZ, sScriptEditorFontSize) Then
            nScriptEditorFontSize = CInt(sScriptEditorFontSize)
        Else
            nScriptEditorFontSize = 9
        End If
        
        'Get ScriptEditorLeft setting
        Dim sScriptEditorLeft As String
        
        If oRegKey.GetKeyValue("ScriptEditorLeft", REG_SZ, sScriptEditorLeft) Then
            nScriptEditorLeft = CInt(sScriptEditorLeft)
        Else
            nScriptEditorLeft = -1
        End If
        
        'Get ScriptEditorTop setting
        Dim sScriptEditorTop As String
        
        If oRegKey.GetKeyValue("ScriptEditorTop", REG_SZ, sScriptEditorTop) Then
            nScriptEditorTop = CInt(sScriptEditorTop)
        Else
            nScriptEditorTop = -1
        End If
        
        'Get ScriptEditorWidth setting
        Dim sScriptEditorWidth As String
        
        If oRegKey.GetKeyValue("ScriptEditorWidth", REG_SZ, sScriptEditorWidth) Then
            nScriptEditorWidth = CInt(sScriptEditorWidth)
        Else
            nScriptEditorWidth = -1
        End If
        
        'Get ScriptEditorHeight setting
        Dim sScriptEditorHeight As String
        
        If oRegKey.GetKeyValue("ScriptEditorHeight", REG_SZ, sScriptEditorHeight) Then
            nScriptEditorHeight = CInt(sScriptEditorHeight)
        Else
            nScriptEditorHeight = -1
        End If
        
        'Get ScriptEditorMaximised setting
        Dim sScriptEditorMaximised As String
        
        If oRegKey.GetKeyValue("ScriptEditorMaximised", REG_SZ, sScriptEditorMaximised) Then
            bScriptEditorMaximised = CBool(sScriptEditorMaximised)
        Else
            bScriptEditorMaximised = False
        End If
        
        'Get DefaultLoadFolder setting
        Dim sDefaultLoadFolder As String
        
        If oRegKey.GetKeyValue("DefaultLoadFolder", REG_SZ, sDefaultLoadFolder) Then
            g_sDefaultLoadFolder = sDefaultLoadFolder
        Else
            g_sDefaultLoadFolder = ""
        End If
        
        'Get DefaultSaveFolder setting
        Dim sDefaultSaveFolder As String
        
        If oRegKey.GetKeyValue("DefaultSaveFolder", REG_SZ, sDefaultSaveFolder) Then
            g_sDefaultSaveFolder = sDefaultSaveFolder
        Else
            g_sDefaultSaveFolder = ""
        End If
        
        'Read Most Recently Used files list
        g_oMRUFiles.ReadFromRegistry oRegKey
        
        'Get UseCreaturesVersion setting
        Dim sUseCreaturesVersion As String
        
        If oRegKey.GetKeyValue("UseCreaturesVersion", REG_SZ, sUseCreaturesVersion) Then
            nCreaturesVersion = CInt(sUseCreaturesVersion)
            
            oRegKey.CloseKey
        Else
            nCreaturesVersion = cvcCreatures2
            If oRegKey.OpenKey(HKEY_LOCAL_MACHINE, sCreatures1RegistryKey) Then
                If oRegKey.OpenKey(HKEY_LOCAL_MACHINE, sCreatures2RegistryKey) Then
                    'Load frmPreferences
                    'frmPreferences.tabPreferences.Tab = 2
                    'frmPreferences.Show vbModal
                Else
                    nCreaturesVersion = cvcCreatures1
                End If
            Else
                If oRegKey.OpenKey(HKEY_LOCAL_MACHINE, sCreatures2RegistryKey) Then
                    nCreaturesVersion = cvcCreatures2
                End If
            End If
        End If
    End If
    
    If g_sDefaultLoadFolder <> "" Then
        g_sCurrentLoadFolder = g_sDefaultLoadFolder
    Else
        g_sCurrentLoadFolder = CurDir
    End If
    
    If g_sDefaultSaveFolder <> "" Then
        g_sCurrentSaveFolder = g_sDefaultSaveFolder
    Else
        g_sCurrentSaveFolder = CurDir
    End If
    
    GetCreaturesSettings
End Sub

Public Sub GetCreaturesSettings()
    GetBoBCoBSettingsC1
    GetBoBCoBSettingsC2
End Sub

Public Sub GetBoBCoBSettingsC1()
    Dim oRegKey As New RegistryKey
    Dim sPath As String
    
    g_bC1Installed = False
    
    If oRegKey.OpenKey(HKEY_LOCAL_MACHINE, sCreatures1RegistryKey) Then
        g_bC1Installed = True
        
        If oRegKey.GetKeyValue("Main Directory", REG_SZ, sC1MainPath) Then
            sC1LauncherPath = """" & sC1MainPath & "Creatures.exe"" -embedding"
        End If
        
        oRegKey.CloseKey
    End If
End Sub

Public Sub GetBoBCoBSettingsC2()
    Dim oRegKey As New RegistryKey
    Dim sPath As String
    
    g_bC2Installed = False
    
    If oRegKey.OpenKey(HKEY_LOCAL_MACHINE, sCreatures2RegistryKey) Then
        g_bC2Installed = True
        
'        If oRegKey.GetKeyValue("Main Directory", REG_SZ, sPath) Then
'            sC2LauncherPath = """" & sPath & "Creatures2.exe"" -embedding"
'        End If
        
        oRegKey.GetKeyValue "Main Directory", REG_SZ, sC2MainPath
        oRegKey.GetKeyValue "Sounds Directory", REG_SZ, sC2SoundPath
        oRegKey.GetKeyValue "Images Directory", REG_SZ, sC2ImagePath
        
        oRegKey.CloseKey
    End If
End Sub

Public Sub WriteBoBCoBSettings()
    Dim oRegKey As New RegistryKey
    
    'BoBCoB Registry settings
    If oRegKey.OpenKey(HKEY_CURRENT_USER, sBoBCoBRegistryKey, True) Then
        'Set CLIAlwaysOnTop setting
        Dim sCLIAlwaysOnTop As String
        
        sCLIAlwaysOnTop = CStr(bCommandLineInterfaceAlwaysOnTop)
        oRegKey.SetKeyValue "CLIAlwaysOnTop", REG_SZ, sCLIAlwaysOnTop
        
        'Set UseCreaturesVersion setting
        Dim sUseCreaturesVersion As String
        
        sUseCreaturesVersion = CStr(nCreaturesVersion)
        oRegKey.SetKeyValue "UseCreaturesVersion", REG_SZ, sUseCreaturesVersion
        
        'Set ScriptEditorTabSize setting
        Dim sScriptEditorTabSize As String
        
        sScriptEditorTabSize = CStr(nScriptEditorTabSize)
        oRegKey.SetKeyValue "ScriptEditorTabSize", REG_SZ, sScriptEditorTabSize
        
        'Set ScriptEditorFontName setting
        oRegKey.SetKeyValue "ScriptEditorFontName", REG_SZ, sScriptEditorFontName
        
        'Set ScriptEditorFontSize setting
        Dim sScriptEditorFontSize As String
        
        sScriptEditorFontSize = CStr(nScriptEditorFontSize)
        oRegKey.SetKeyValue "ScriptEditorFontSize", REG_SZ, sScriptEditorFontSize
        
        'Set ScriptEditorLeft setting
        Dim sScriptEditorLeft As String
        
        sScriptEditorLeft = CStr(nScriptEditorLeft)
        oRegKey.SetKeyValue "ScriptEditorLeft", REG_SZ, sScriptEditorLeft
        
        'Set ScriptEditorTop setting
        Dim sScriptEditorTop As String
        
        sScriptEditorTop = CStr(nScriptEditorTop)
        oRegKey.SetKeyValue "ScriptEditorTop", REG_SZ, sScriptEditorTop
        
        'Set ScriptEditorWidth setting
        Dim sScriptEditorWidth As String
        
        sScriptEditorWidth = CStr(nScriptEditorWidth)
        oRegKey.SetKeyValue "ScriptEditorWidth", REG_SZ, sScriptEditorWidth
        
        'Set ScriptEditorHeight setting
        Dim sScriptEditorHeight As String
        
        sScriptEditorHeight = CStr(nScriptEditorHeight)
        oRegKey.SetKeyValue "ScriptEditorHeight", REG_SZ, sScriptEditorHeight
        
        'Set ScriptEditorMaximised setting
        Dim sScriptEditorMaximised As String
        
        sScriptEditorMaximised = CStr(bScriptEditorMaximised)
        oRegKey.SetKeyValue "ScriptEditorMaximised", REG_SZ, sScriptEditorMaximised
        
        'Set DefaultLoadFolder setting
        Dim sDefaultLoadFolder As String
        
        sDefaultLoadFolder = g_sDefaultLoadFolder
        oRegKey.SetKeyValue "DefaultLoadFolder", REG_SZ, sDefaultLoadFolder
        
        'Set DefaultSaveFolder setting
        Dim sDefaultSaveFolder As String
        
        sDefaultSaveFolder = g_sDefaultSaveFolder
        oRegKey.SetKeyValue "DefaultSaveFolder", REG_SZ, sDefaultSaveFolder
        
        'Write Most Recently Used files list
        g_oMRUFiles.WriteToRegistry oRegKey
        
        oRegKey.CloseKey
    End If
End Sub

Public Function COBtoCOS(sCOB As String) As String
    Dim I As Integer
    Dim sChar As String
    Dim sCOS As String
    
    For I = 1 To Len(sCOB)
        sChar = Mid(sCOB, I, 1)
        If sChar = "," Then
            sCOS = sCOS & vbCrLf
        Else
            sCOS = sCOS & sChar
        End If
    Next
    
    COBtoCOS = sCOS
End Function

Public Function COStoCOB(sCOS As String) As String
    Dim I As Integer
    Dim J As Integer
    Dim sChar As String
    Dim sCOB As String
    Dim bInBrackets As Boolean
    
    I = 1
    Do While I <= Len(sCOS)
        sChar = Mid(sCOS, I, 1)
        If sChar = vbCr Then
            J = Len(sCOB)
            If J > 0 Then
                sChar = Mid(sCOB, J, 1)
                Do While sChar = " " Or sChar = vbTab
                    J = J - 1
                    sChar = Mid(sCOB, J, 1)
                Loop
                sCOB = Left(sCOB, J)
            End If
            If Right(sCOB, 1) <> "," Then
                sCOB = sCOB & ","
            End If
            I = I + 1
            sChar = Mid(sCOS, I, 1)
            Do While sChar = vbCr Or sChar = vbLf Or sChar = vbTab Or sChar = " "
                I = I + 1
                sChar = Mid(sCOS, I, 1)
            Loop
        ElseIf (sChar = "*" Or sChar = "'") And Not bInBrackets Then
            I = I + 1
            sChar = Mid(sCOS, I, 1)
            Do While sChar <> vbCr And sChar <> vbLf And I < Len(sCOS)
                I = I + 1
                sChar = Mid(sCOS, I, 1)
            Loop
        ElseIf sChar <> vbTab And sChar <> "," And Not (sChar = " " And sCOB = "") Then
            If sChar = "[" Then
                bInBrackets = True
            ElseIf sChar = "]" Then
                bInBrackets = False
            End If
            
            sCOB = sCOB & sChar
            I = I + 1
        Else
            I = I + 1
        End If
    Loop
    
    If Left(sCOB, 1) = "," Then
        sCOB = Right(sCOB, Len(sCOB) - 1)
    End If
    
    If Right(sCOB, 1) = "," Then
        sCOB = Left(sCOB, Len(sCOB) - 1)
    End If
    
    COStoCOB = sCOB
End Function

Public Function EditScript(sCaption As String, sScript As String) As Boolean
    Dim oForm As frmScriptEditor
    
    Set oForm = New frmScriptEditor
    
    EditScript = oForm.Display(sCaption, sScript)
    
    Set oForm = Nothing
End Function

Public Sub StartCreatures1()
    If sC1LauncherPath = "" Then
        Exit Sub
    End If
    
    Shell sC1LauncherPath, vbNormalFocus
End Sub

