The following code illustrates the use of the
CodeObject property.
' ########################################################################################
' Microsoft Script Control example.
' 2008 José Roca - Use at your own risk.
' ########################################################################################
' SED_PBWIN ' Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#DEBUG ERROR ON
#INCLUDE "MSSCRIPT.INC"
' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN
LOCAL pSc AS IScriptControl
LOCAL strScript AS STRING
LOCAL pModules AS IScriptModuleCollection
LOCAL pModule AS IScriptModule
LOCAL pCodeObject AS IDispatch
LOCAL oCodeObject AS DISPATCH
local vPrm1 AS VARIANT
local vPrm2 AS VARIANT
local vRes AS VARIANT
' Creates an instance of the Microsoft Script Control
pSc = NEWCOM "MSScriptControl.ScriptControl"
IF ISNOTHING(pSc) THEN
MSGBOX "Error creating an instance of the Microsoft Script Control"
EXIT FUNCTION
END IF
TRY
' Set the language. It can be "VBScript" or "JScript"
pSc.Language = UCODE$("VBScript")
' *** Add a new module and a procedure and call it using PB automation ***
' Get a reference to the modules collection
pModules = pSc.Modules
IF ISOBJECT(pModules) THEN
pModule = pModules.Add(UCODE$("MyModule"))
IF ISOBJECT(pModule) THEN
' Add a procedure to the module
strScript = "Function Multiply(vPrm1, vPrm2)" & $CRLF & _
" Multiply = vPrm1 * vPrm2" & $CRLF & _
"End Function"
pModule.AddCode UCODE$(strScript)
' Get the dispatch interface of the module
pCodeObject = pModule.CodeObject
IF ISOBJECT(pCodeObject) THEN
oCodeObject = pCodeObject
pCodeObject = NOTHING
END IF
' Use PB automation to call the procedure
vPrm1 = 6 : vPrm2 = 5
OBJECT CALL oCodeObject.Multiply(vPrm1, vPrm2) TO vRes
MSGBOX "Result: " & STR$(VARIANT#(vRes))
END IF
END IF
CATCH
MSGBOX MSScriptControl_GetErrorInfo(pSc, OBJRESULT)
FINALLY
oCodeObject = NOTHING
pModule = NOTHING
pModules = NOTHING
END TRY
' Releases the interface
pSc = NOTHING
END FUNCTION
' ========================================================================================