VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "classCOB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' TA cob file class. '

Option Explicit

Private Scripts() As New classCOBscript
Private Pieces() As String

' COB command codes. '
Private Codes() As New classCOBcode

' BOS file buffer. '
Private FileBuffer As String

' Import a BOS text script. '
Public Sub ImportBOS(Filename As String)
    Dim File As Integer
    
    On Error GoTo Error
    File = FreeFile
    Open Filename For Binary As File
    FileBuffer = String(FileLen(Filename), " ")
    Get File, , FileBuffer
    Close File
    
Error:
    FrmMain.TxtCOB.Text = FileBuffer
End Sub

' Import a compiled COB script. '
Public Sub ImportCOB(Filename As String)
    Dim Header As COBHeader
    Dim ScriptCodeIndex() As Long
    Dim PieceNameIndex() As Long
    Dim ScriptNameIndex() As Long
    Dim File As Integer
    Dim Index As Long
    Dim Buffer As Byte
    Dim Display As String
    
    ' Initialize. '
    On Error GoTo Error
    File = FreeFile
    Open Filename For Binary As File
    
    ' Load header. '
    Get File, , Header
    If Header.Version <> 4 Then Exit Sub
    
    ' Load pieces. '
    ReDim Pieces(Header.NumPieces - 1)
    ReDim PieceNameIndex(Header.NumPieces - 1)
    
    Seek File, Header.OffsetPieceNameOffsetArray + 1
    Get File, , PieceNameIndex()
    For Index = 0 To UBound(Pieces)
        Seek File, PieceNameIndex(Index) + 1
        Get File, , Buffer
        Do While Buffer <> 0
            Pieces(Index) = Pieces(Index) & Chr(Buffer)
            Get File, , Buffer
        Loop
    Next
    
    ' Load scripts. '
    ReDim Scripts(Header.NumScripts - 1)
    ReDim ScriptCodeIndex(Header.NumScripts - 1)
    ReDim ScriptNameIndex(Header.NumScripts - 1)
    
    Seek File, Header.OffsetScriptCodeIndexArray + 1
    Get File, , ScriptCodeIndex()
    For Index = 0 To UBound(ScriptCodeIndex) - 1
        Seek File, Header.OffsetScriptCode + ScriptCodeIndex(Index) * 4 + 1
        Scripts(Index).LoadScript File, ScriptCodeIndex(Index + 1) - ScriptCodeIndex(Index)
    Next
    Scripts(Index).LoadScript File, Header.EndOfCode - ScriptCodeIndex(Index)
    
    Seek File, Header.OffsetScriptNameOffsetArray + 1
    Get File, , ScriptNameIndex()
    For Index = 0 To UBound(ScriptNameIndex)
        Seek File, ScriptNameIndex(Index) + 1
        Get File, , Buffer
        Do While Buffer <> 0
            Scripts(Index).Name = Scripts(Index).Name & Chr(Buffer)
            Get File, , Buffer
        Loop
    Next
    
    ' Display cob information. '
    With FrmMain
        .TxtInfo(0) = Header.Version
        .TxtInfo(1) = Header.NumScripts
        .TxtInfo(2) = Header.NumPieces
        .TxtInfo(3) = Header.EndOfCode
        .TxtInfo(4) = Header.NumStatics
        .TxtInfo(5) = Header.Always0
        .TxtInfo(6) = Header.OffsetScriptCodeIndexArray
        .TxtInfo(7) = Header.OffsetScriptNameOffsetArray
        .TxtInfo(8) = Header.OffsetPieceNameOffsetArray
        .TxtInfo(9) = Header.OffsetScriptCode
        .TxtInfo(10) = Header.OffsetFirstScriptName
        
        .LstScripts.Clear
        For Index = 0 To UBound(Scripts)
            .LstScripts.AddItem Scripts(Index).Name
        Next
        
        .LstPieces.Clear
        For Index = 0 To UBound(Pieces)
            .LstPieces.AddItem Pieces(Index)
        Next
        
        For Index = 0 To UBound(Scripts)
            Display = Display & "/////////////////////////////////////////////////////" & Chr(13) & Chr(10)
            Display = Display & "// " & Scripts(Index).Name & Chr(13) & Chr(10)
            Scripts(Index).DisplayScript Display, Codes()
            Display = Display & Chr(13) & Chr(10)
            DoEvents
        Next
        .TxtCOB = Display
    End With
    
    ' Cleanup. '
    Close File
Error:
End Sub

Public Sub LoadCodes(Filename As String)
    Dim File As Integer
    Dim Count As Integer
    Dim Buffer As String
    
    On Error GoTo Error
    File = FreeFile
    Open Filename For Binary As File
    
    Do While Not EOF(File)
        Line Input #File, Buffer
        If Len(Buffer) = 28 Then
            ReDim Preserve Codes(Count)
            Codes(Count).Load Buffer
            Count = Count + 1
        End If
    Loop
    
    Close File
Error:
End Sub
