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.
' ########################################################################################
' 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
' ########################################################################################