Hosting VBScript in your PowerBASIC application

[José Roca]

 
The basic work flow is as follows:

• 
  You start the VBScript engine, vbscript.dll, and obtain IActiveScript and IActiveScriptParse interfaces.
  
• 
  You give the VBScript engine your implementation of IActiveScriptSite, which the engine uses later to obtain and call to your objects.
  
• 
  You add the objects that you implement and want to make available to scripts by calling IActiveScript.AddNamedItem.
  
• 
  You provide the script text to execute through IActiveScriptParse.ParseScriptText.
  Note that this doesn't actually run the script yet.
  
• 
  The script engine will now call into your IActiveScriptSite.GetItemInfo for any objects it doesn't recognize, to get their interface pointers.
  
• 
  You call IActiveScript.SetScriptState with SCRIPT_STATE_CONNECTED to run the script.
  
• 
  The VBScript engine parses the text in the script for you and when it encounters a method call or property reference, it delegates the implementation to your provided interfaces.
  

Code Select Expand


' ########################################################################################
' Hosting VBScript in your PowerBASIC application
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

' ========================================================================================
' The basic work flow is as follows:
' 1. You start the VBScript engine, vbscript.dll, and obtain IActiveScript and
'    IActiveScriptParse interfaces.
' 2. You give the VBScript engine your implementation of IActiveScriptSite, which the
'    engine uses later to obtain and call to your objects.
' 3. You add the objects that you implement and want to make available to scripts by
'    calling IActiveScript.AddNamedItem().
' 4. You provide the script text to execute through IActiveScriptParse.ParseScriptText().
'    Note that this doesn't actually run the script yet.
' 5. The script engine will now call into your IActiveScriptSite.GetItemInfo() for any
'    objects it doesn't recognize, to get their interface pointers.
' 6. You call IActiveScript.SetScriptState() with SCRIPT_STATE_CONNECTED to run the script.
' 7. The VBScript engine parses the text in the script for you and when it encounters a
'    method call or property reference, it delegates the implementation to your provided
'    interfaces.
' ========================================================================================

#COMPILE CON
#DIM ALL

'/* header files for imported files */
#INCLUDE ONCE "ActivScp.inc"

' ########################################################################################
' Class MyObject
' Note: We need to declare the class AS COMMON to avoid dead code removal because the
' methods aren't called directly by the code but by the ActivaScript engine.
' ########################################################################################

$IID_CMyObject = GUID$("{F9E4BF70-EFA8-411E-A142-F4B02D89D621}")
$IID_IMyObject = GUID$("{F9E4BF70-EFA8-411E-A142-F4B02D89D622}")

CLASS CMyObject $IID_CMyObject AS COMMON

   INTERFACE IMyObject $IID_IMyObject

   INHERIT IDispatch

   METHOD SayHi (BYVAL bstrTo AS WSTRING)
      PRINT "Say Hi to " & bstrTo
   END METHOD

   METHOD Sum (BYVAL a AS LONG, BYVAL b AS LONG)
      PRINT STR$(a) & " +" STR$(b) & " =" & STR$(a + b) & ", isn't it?"
   END METHOD

   END INTERFACE

END CLASS
' ########################################################################################

' ########################################################################################
' Class CMyScriptSite
' Note: We need to declare the class AS COMMON to avoid dead code removal because the
' methods aren't called directly by the code but by the ActivaScript engine.
' ########################################################################################

$IID_CMyScriptSite = GUID$("{F9E4BF70-EFA8-411E-A142-F4B02D89D620}")

CLASS CMyScriptSite $IID_CMyScriptSite AS COMMON

   INSTANCE m_wszObjectName AS WSTRINGZ * 260
   INSTANCE m_pScriptObjectUnk AS IUnknown

   CLASS METHOD Create
      ' // Creates an instance of our object
      m_pScriptObjectUnk = CLASS "CMyObject"
      m_wszObjectName = "MyObject"
   END METHOD

   CLASS METHOD Destroy
      ' // Releases our object
      m_pScriptObjectUnk = NOTHING
   END METHOD

   ' =====================================================================================
   ' Custom implementation of the IActiveScriptSite interface
   ' =====================================================================================
   INTERFACE IActiveScriptSiteImpl $IID_IActiveScriptSite

      INHERIT IUnknown

      ' ==================================================================================
      ' Retrieves the locale identifier associated with the host's user interface.
      ' ==================================================================================
      METHOD GetLCID (BYREF plcid AS LONG) AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Allows the scripting engine to obtain information about an item added with the
      ' IActiveScript.AddNamedItem method.
      ' ==================================================================================
      METHOD GetItemInfo (BYREF wszName AS WSTRINGZ, BYVAL dwReturnMask AS DWORD, BYREF ppiunkItem AS DWORD, BYREF ppti AS DWORD) AS LONG

         LOCAL IID_CMyScriptSite AS GUID

         ' // Is it expecting an ITypeInfo?
         IF VARPTR(ppti) THEN
            ' // Default to null
            ppti = %NULL
            ' // Return if asking about ITypeInfo...
            IF (dwReturnMask AND %SCRIPTINFO_ITYPEINFO) = %SCRIPTINFO_ITYPEINFO THEN
               METHOD = %TYPE_E_ELEMENTNOTFOUND
               EXIT METHOD
            END IF
         END IF

         ' // Is the engine passing an IUnknown buffer?
         IF VARPTR(ppiunkItem) THEN
            ' // Default to null
            ppiunkItem = %NULL
            ' // Is Script Engine looking for an IUnknown for our object?
            IF (dwReturnMask AND %SCRIPTINFO_IUNKNOWN) = %SCRIPTINFO_IUNKNOWN THEN
               ' // Check for our object name...
               IF wszName = m_wszObjectName THEN
                  ' // Provide our object.
                  ppiunkItem = OBJPTR(m_pScriptObjectUnk)
                  ' // AddRef our object...
                  m_pScriptObjectUnk.AddRef
               END IF
            END IF
         END IF

         METHOD = %S_OK

      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Retrieves a host-defined string that uniquely identifies the current document version.
      ' ==================================================================================
      METHOD GetDocVersionString (BYREF bstrVersion AS WSTRING) AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Informs the host that the script has completed execution.
      ' ==================================================================================
      METHOD OnScriptTerminate (BYREF pvarResult AS VARIANT, BYREF pexcepinfo AS EXCEPINFO) AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Informs the host that the scripting engine has changed states.
      ' ==================================================================================
      METHOD OnStateChange (BYVAL ssScriptState AS DWORD) AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Informs the host that an execution error occurred while the engine was running the script.
      ' ==================================================================================
      METHOD OnScriptError (BYVAL pscripterror AS IActiveScriptError) AS LONG

         LOCAL bstrSourceLine AS WSTRING
         LOCAL ei AS EXCEPINFO
         LOCAL bstrlen AS LONG

         pscripterror.GetSourceLineText bstrSourceLine
         STDOUT "IActiveScriptSite.OnScriptError" & $CRLF & _
                "*** Source line ***" & $CRLF & bstrSourceLine

         LOCAL hr AS LONG
         LOCAL dwSourceContext AS DWORD
         LOCAL ulLineNumber AS DWORD
         LOCAL lCharacterPosition AS LONG
         hr = pscripterror.GetSourcePosition(dwSourceContext, ulLineNumber, lCharacterPosition)
         IF hr = %S_OK THEN
            IF dwSourceContext THEN PRINT "Source context: " & FORMAT$(dwSourceContext)
            IF ulLineNumber THEN PRINT "Line number " & FORMAT$(ulLineNumber)
            IF lCharacterPosition THEN PRINT "Character Position: " & FORMAT$(lCharacterPosition)
         END IF

         ' // Retrieve the error information from EXCEPINFO
         pscripterror.GetExceptionInfo ei
         IF ei.sCode THEN
            PRINT "Error code: " & FORMAT$(ei.sCode) & " <" & HEX$(ei.scode) & ">"
         END IF
         IF ei.bstrSource THEN
            PRINT "Error source: " & ei.@bstrSource
            SysFreeString ei.bstrSource
         END IF
         IF ei.bstrDescription THEN
            PRINT "Error description: " & ei.@bstrDescription
            SysFreeString ei.bstrDescription
         END IF
         IF ei.bstrHelpFile THEN
            PRINT "Help file: " & ei.@bstrHelpFile
            IF ei.dwHelpContext THEN PRINT "Help context ID: " & FORMAT$(ei.dwHelpContext)
            SysFreeString ei.bstrHelpFile
         END IF

         METHOD = %S_OK

      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Informs the host that the scripting engine has begun executing the script code.
      ' ==================================================================================
      METHOD OnEnterScript () AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

      ' ==================================================================================
      ' Informs the host that the scripting engine has returned from executing script code.
      ' ==================================================================================
      METHOD OnLeaveScript () AS LONG
         METHOD = %S_OK
      END METHOD
      ' ==================================================================================

   END INTERFACE
   ' =====================================================================================

END CLASS
' ########################################################################################


' ########################################################################################
' Main
' ########################################################################################
FUNCTION PBMAIN () AS LONG

   LOCAL hr AS LONG
   LOCAL pMySite AS IActiveScriptSiteImpl
   LOCAL wszObjectName AS WSTRINGZ * 260
   LOCAL wszScript AS WSTRINGZ * 260
   LOCAL ei AS EXCEPINFO

   ' // Create an instance of our script site
   pMySite = CLASS "CMyScriptSite"
   IF ISNOTHING(pMySite) THEN EXIT FUNCTION

   ' // Start inproc script engine, VBSCRIPT.DLL
   LOCAL pIActiveScript AS IActiveScript
   pIActiveScript = NEWCOM CLSID $CLSID_VBScript
   IF ISNOTHING(pIActiveScript) THEN  EXIT FUNCTION

   ' // Get engine's IActiveScriptParse interface
   LOCAL pIActiveScriptParse AS IActiveScriptParse
   pIActiveScriptParse = pIActiveScript
   IF ISNOTHING(pIActiveScriptParse) THEN  EXIT FUNCTION

   ' // Give the engine our IActiveScriptSite interface...
   hr = pIActiveScript.SetScriptSite(pMySite)
   ' // Give the engine a chance to initialize itself...
   hr = pIActiveScriptParse.InitNew
   ' // Add a root-level item to the engine's name space...
   wszObjectName = "MyObject"
   hr = pIActiveScript.AddNamedItem(wszObjectName, %SCRIPTITEM_ISVISIBLE OR %SCRIPTITEM_ISSOURCE)
   wszScript = "Sum 2,3" & $CRLF & _
                "SayHi(" & $DQ & "Active Scripting" & $DQ & ")"
   hr = pIActiveScriptParse.ParseScriptText(wszScript, wszObjectName, _
        NOTHING, "", 0, 0, 0, BYVAL %NULL, ei)
   ' // Set the engine state. This line actually triggers the execution of the script.
   hr = pIActiveScript.SetScriptState(%SCRIPTSTATE_CONNECTED)

   ' // Close script and release interfaces...
   pIActiveScript.Close
   pIActiveScriptParse = NOTHING
   pIActiveScript = NOTHING
   pMySite = NOTHING

   WAITKEY$

END FUNCTION
' ########################################################################################