0 Members and 1 Guest are viewing this topic.
' ########################################################################################' 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 INTERFACEEND 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' ########################################################################################
