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

Public Event ScriptError(ByRef Sender As clsScript, ByRef Error As MSScriptControl.Error)
Public Event Error(ByRef Sender As clsScript, ByRef Error As VBA.ErrObject)

Private istrFile As String
Private istrName As String
Private istrCode As String
Private iobjZbar As ZBARCOMLib.Zaap
Private iblnEnabled As Boolean
Private iscHost As MSScriptControl.ScriptControl
Attribute iscHost.VB_VarHelpID = -1
Private iscmUpdateModule As MSScriptControl.Module
Private iscmAssistModule As MSScriptControl.Module
Private istrOutput As String
Private WithEvents iclsGlobals As clsScriptGlobals
Attribute iclsGlobals.VB_VarHelpID = -1

Friend Sub Initialize(aobjZBar As ZBARCOMLib.Zaap)
    Set iobjZbar = aobjZBar
End Sub

Friend Sub Load(ByRef Filename As String)
    Dim lstrExtension As String
    Dim lintBOM As Long
    Dim lbytData() As Byte
    Dim lintModule As Long, lintProc As Long
    Dim lscModule As MSScriptControl.Module
    Dim lscProc As MSScriptControl.Procedure
    
    If InStr(Filename, ".") > 0 Then
        lstrExtension = Mid$(Filename, InStrRev(Filename, "."))
    End If
    
    istrFile = Filename
    istrName = Mid$(Filename, InStrRev(Filename, "\") + 1)
    
    Open istrFile For Binary Access Read As #1
    Get #1, , lintBOM
    If (lintBOM And 16777215) = &HBFBBEF Then   ' UTF-8
        ReDim lbytData(1 To LOF(1) - 3)
        Get #1, 4, lbytData
        istrCode = ByteArrayToString(lbytData, CP_UTF8)
    ElseIf (lintBOM And 65535) = &HFEFF& Then ' UTF-16 (LE)
        ReDim lbytData(1 To LOF(1) - 2)
        Get #1, 3, lbytData
        istrCode = lbytData()
    Else
        Seek #1, 1
        istrCode = Input$(LOF(1), #1)
    End If
    Close #1
    
    Set iclsGlobals = New clsScriptGlobals
    Set iscHost = New MSScriptControl.ScriptControl
    ' TODO: properly determine the language (found in registry)!
    Select Case LCase$(lstrExtension)
    Case ".vbs", ".vbscript"
        iscHost.Language = "VBScript"
    Case Else
        iscHost.Language = "JScript"
    End Select
    iscHost.AddObject "zbar", iobjZbar, False
    iscHost.AddObject App.EXEName, iclsGlobals, True
    On Error Resume Next
    iscHost.AddCode istrCode
    If Err.Number Then
        iblnEnabled = False
        RaiseEvent ScriptError(Me, iscHost.Error)
    End If
    On Error GoTo 0
    For lintModule = 1 To iscHost.Modules.Count
        Set lscModule = iscHost.Modules.Item(lintModule)
        For lintProc = 1 To lscModule.Procedures.Count
            Set lscProc = lscModule.Procedures.Item(lintProc)
            Select Case lscProc.Name
            Case "onUpdate"
                If iscmUpdateModule Is Nothing Then
                    Set iscmUpdateModule = lscModule
                End If
            Case "onAssist"
                If iscmAssistModule Is Nothing Then
                    Set iscmAssistModule = lscModule
                End If
            End Select
        Next
    Next
End Sub

Public Property Get Path() As String
    Path = istrFile
End Property

Public Property Get Name() As String
    Name = istrName
End Property
Public Property Let Name(ByVal astrNew As String)
    istrName = astrNew
End Property

Public Property Get Enabled() As Boolean
    Enabled = iblnEnabled
End Property
Public Property Let Enabled(ByVal ablnNew As Boolean)
    iblnEnabled = ablnNew
End Property

Public Property Get Host() As MSScriptControl.ScriptControl
    Set Host = iscHost
End Property

Public Property Get Output() As String
    Output = istrOutput
End Property


Public Property Get CanUpdate() As Boolean
    CanUpdate = Not iscmUpdateModule Is Nothing
End Property

Public Property Get CanAssist() As Boolean
     CanAssist = Not iscmAssistModule Is Nothing
End Property


Public Function DoUpdate() As Variant
    If CanUpdate Then
        On Error Resume Next
        DoUpdate = iscmUpdateModule.CodeObject.onUpdate(iobjZbar)
        If Err.Number Then
            If iscHost.Error.Number Then
                RaiseEvent ScriptError(Me, iscHost.Error)
            Else
                RaiseEvent Error(Me, Err)
            End If
        End If
    End If
End Function

Public Function DoAssist() As Variant
    Dim lvarResult As Variant
    
    If CanAssist Then
        On Error Resume Next
        lvarResult = iscmAssistModule.CodeObject.onAssist(iobjZbar)
        If Err.Number Then
            If iscHost.Error.Number Then
                iobjZbar.WriteZbarError Asc("s"), iscHost.Error.Description
                RaiseEvent ScriptError(Me, iscHost.Error)
            Else
                RaiseEvent Error(Me, Err)
            End If
        End If
        On Error GoTo 0
    End If
    
    DoAssist = lvarResult
End Function

Public Property Get Code() As String
    Code = istrCode
End Property

Private Sub iclsGlobals_GetName(ByRef astrName As String)
    astrName = istrName
End Sub

Private Sub iclsGlobals_GetOutput(ByRef astrText As String)
    astrText = istrOutput
End Sub

Private Sub iclsGlobals_SetOutput(ByVal astrText As String)
    istrOutput = astrText
    If frmMain.tsScript.SelectedItem.Key = "Console" Then
        frmMain.txtConsole.Text = istrOutput
    End If
End Sub
