IScriptControl.Error Property

[José Roca]

The following code adds an script containing a division by zero. An error is generated at runtime and the MSScriptControl_GetErrorInfo wrapper function is used to display error information.

Code: [Select]

' ########################################################################################
' Microsoft Script Control example.
' 2008 José Roca - Use at your own risk.
' ########################################################################################

' SED_PBWIN  ' Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "MSSCRIPT.INC"

' ========================================================================================
' Main
' ========================================================================================
FUNCTION PBMAIN

   LOCAL pSc AS IScriptControl
   LOCAL strScript AS STRING
   LOCAL vRes AS VARIANT
   LOCAL vPrms AS VARIANT
   LOCAL rgsabound AS SAFEARRAYBOUND
   LOCAL psa AS DWORD
   LOCAL vPrm AS VARIANT
   LOCAL vEmpty AS VARIANT
   LOCAL ix AS LONG

   ' Create 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")
      ' Make an script (will throw a division by zero error).
      strScript = "Sub DivideByZero" & $CRLF & _
                  "   Dim prime" & $CRLF & _
                  "   prime = 3" & $CRLF & _
                  "   MsgBox prime/0" & $CRLF & _
                  "End Sub"
      pSc.AddCode UCODE$(StrScript)
      ' Create a safearray with zero elements
      ' Note: Parameters are passed as a safearray by reference. Therefore, we
      ' need to always pass a valid pointer.
      rgsabound.lLBound = 1
      rgsabound.cElements = 0
      psa = SafeArrayCreate(%VT_VARIANT, 1, rgsabound)
      ' Run the script
      vRes = pSc.Run(UCODE$("DivideByZero"), psa)
   CATCH
      MSGBOX MSScriptControl_GetErrorInfo(pSc, OBJRESULT)
   FINALLY
      ' Destroy the safearray
      IF psa THEN SafeArrayDestroy psa
      psa = %NULL
   END TRY

   ' Releases the interface
   pSc = NOTHING

END FUNCTION
' ========================================================================================


[José Roca]

 
These are the MSScriptControl_GetErrorDescription and MSScriptControl_GetErrorInfo wrapper functions included in MSSCRIPT.INC.

Code: [Select]

' ########################################################################################
' Returns an string containing information about the VbScript runtime errors
' ########################################################################################
FUNCTION MSScriptControl_GetErrorDescription (BYVAL lErrCode AS LONG) AS STRING

  LOCAL s AS STRING
  LOCAL wErrCode AS WORD

  ' Convert to a Word
  wErrCode = lErrCode

  SELECT CASE AS LONG wErrCode
     CASE     5 : s = "Invalid procedure call or argument"
     CASE     6 : s = "Overflow"
     CASE     7 : s = "Out of memory"
     CASE     9 : s = "Subscript out of range"
     CASE    10 : s = "Array fixed or temporarily locked"
     CASE    11 : s = "Division by zero"
     CASE    13 : s = "Type mismatch"
     CASE    14 : s = "Out of string space"
     CASE    28 : s = "Out of stack space"
     CASE    35 : s = "Sub or Function not defined"
     CASE    48 : s = "Error in loading DLL"
     CASE    51 : s = "Internal error"
     CASE    53 : s = "File not found"
     CASE    57 : s = "Device I/O error"
     CASE    58 : s = "File already exists"
     CASE    61 : s = "Disk full"
     CASE    67 : s = "Too many files"
     CASE    70 : s = "Permission denied"
     CASE    75 : s = "Path file/access error"
     CASE    76 : s = "Path not found"
     CASE    91 : s = "Object variable or With block variable not set"
     CASE    92 : s = "For loop not initialized"
     CASE    94 : s = "Invalid use of Null"
     CASE   322 : s = "Can't create necessary temporary file"
     CASE   424 : s = "Object required"
     CASE   429 : s = "ActiveX component can't create object"
     CASE   430 : s = "Class doesn't support Automation"
     CASE   432 : s = "File name or class name not found during Automation operation"
     CASE   438 : s = "Object doesn't support this property or method"
     CASE   440 : s = "Automation error"
     CASE   445 : s = "Object doesn't support this action"
     CASE   446 : s = "Object doesn't support named arguments"
     CASE   447 : s = "Object doesn't support current locale setting"
     CASE   448 : s = "Named argument not found"
     CASE   449 : s = "Argument not optional"
     CASE   450 : s = "Wrong number of arguments or invalid property assignment"
     CASE   451 : s = "Object not a collection"
     CASE   452 : s = "Specified DLL function not found"
     CASE   455 : s = "Code resource lock error"
                ' This error can only occur on the Macintosh
     CASE   457 : s = "This key already associated with an element of this collection"
     CASE   458 : s = "Variable uses an Automation type not supporyed by VBScript"
     CASE   500 : s = "Variable is undefined"
     CASE   501 : s = "Illegal assignment"
     CASE   502 : s = "Object not safe for scripting"
     CASE   503 : s = "Object not safe for initializing"
     CASE  1001 : s = "Out of memory"
     CASE  1002 : s = "Syntax error"
     CASE  1003 : s = "Expected ':'"
     CASE  1004 : s = "Expected ','"
     CASE  1005 : s = "Expected '\'"
     CASE  1006 : s = "Expected ')'"
     CASE  1007 : s = "Expected ']'"
     CASE  1008 : s = "Expected '{'"
     CASE  1009 : s = "Expected '}'"
     CASE  1010 : s = "Expected identifier"
     CASE  1011 : s = "Expected '='"
     CASE  1012 : s = "Expected 'If'"
     CASE  1013 : s = "Expected 'To'"
     CASE  1014 : s = "Expected 'End'"
     CASE  1015 : s = "Expected 'Function'"
     CASE  1016 : s = "Expected 'Sub'"
     CASE  1017 : s = "Expected 'Then'"
     CASE  1018 : s = "Expected 'Wend'"
     CASE  1019 : s = "Expected 'Loop'"
     CASE  1020 : s = "Expected 'Next'"
     CASE  1021 : s = "Expected 'Case'"
     CASE  1022 : s = "Expected 'Select'"
     CASE  1023 : s = "Expected expression"
     CASE  1024 : s = "Expected statement"
     CASE  1025 : s = "Expected end of statement"
     CASE  1026 : s = "Expected integer constant"
     CASE  1027 : s = "Expected 'While' or 'Until'"
     CASE  1028 : s = "Expected 'While', 'Until', or end of statement"
     CASE  1029 : s = "Too many locals or arguments"
     CASE  1030 : s = "Identifier too long"
     CASE  1031 : s = "Invalid number"
     CASE  1032 : s = "Invalid character"
     CASE  1033 : s = "Unterminated string constant"
     CASE  1034 : s = "Unterminated comment"
     CASE  1035 : s = "Nested comment"
     CASE  1037 : s = "Invalid use of 'Me' keyword"
     CASE  1038 : s = "'Loop withour 'Do'"
     CASE  1039 : s = "Invalid 'Exit' statement"
     CASE  1040 : s = "Invalid 'For' loop control variable"
     CASE  1041 : s = "Name redefined"
     CASE  1042 : s = "Must be first statement on this line"
     CASE  1043 : s = "Can't assign to non-ByVal argument"
     CASE  1045 : s = "Expected literal constant"
     CASE  1046 : s = "Expected 'In'"
     CASE 32766 : s = "True"
     CASE 32767 : s = "False"
     CASE 32811 : s = "Element not found"
  END SELECT

  FUNCTION = s

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

' ########################################################################################
' Helper function to retrieve error information.
' ########################################################################################

FUNCTION MSScriptControl_GetErrorInfo (BYVAL pSc AS IScriptControl, OPTIONAL BYVAL lError AS LONG) AS STRING

   LOCAL strMsg AS STRING
   LOCAL pError AS IScriptError
   LOCAL lErrorNumber AS LONG
   LOCAL strErrorSource AS STRING
   LOCAL strErrorDescription AS STRING
   LOCAL strErrorHelpFile AS STRING
   LOCAL lErrorHelpContext AS LONG
   LOCAL strErrorText AS STRING
   LOCAL lErrorLine AS LONG
   LOCAL lErrorColumn AS LONG
   LOCAL ncbBuffer AS DWORD
   LOCAL pBuffer AS ASCIIZ PTR

   ' Exit if it is a null pointer
   IF ISNOTHING(pSc) THEN EXIT FUNCTION

   ' Get a reference to the Error interface
   pError = pSc.Error
   IF ISTRUE ISOBJECT(pError) THEN
      lErrorNumber = pError.Number
      IF lErrorNumber THEN
         strErrorSource = ACODE$(pError.Source)
         strErrorDescription = ACODE$(pError.Description)
         strErrorText = ACODE$(pError.Text)
         lErrorLine = pError.Line
         lErrorColumn = pError.Column
         strMsg = "Error number: " & FORMAT$ (lErrorNumber)& " [&H" & HEX$(lErrorNumber) & "]" & $CRLF & _
                  "Error source: " & strErrorSource & $CRLF & _
                  "Error description: " & strErrorDescription & $CRLF & _
                  "Error text: " & strErrorText & $CRLF & _
                  "Error line: " & FORMAT$(lErrorLine) & $CRLF & _
                  "Error column: " & FORMAT$(lErrorColumn)
         pError.Clear
         pError = NOTHING
      ELSE
         IF lError THEN
            ' See if it is a VBScript error message
            strMsg = MSScriptControl_GetErrorDescription(lError)
            IF LEN(strMsg) THEN
               strMsg = "Error code: " & HEX$(lError) & $CRLF & _
                        "VBScript error code: " & FORMAT$(CWRD(lError)) & $CRLF & strMsg
            ELSE
               strMsg = "Error code: " & HEX$(lError) & $CRLF & OBJRESULT$(lError)
            END IF
         END IF
      END IF
   ELSE
      IF lError THEN
         ' See if it is a VBScript error message
         strMsg = MSScriptControl_GetErrorDescription(lError)
         IF LEN(strMsg) THEN
            strMsg = "Error code: " & HEX$(lError) & $CRLF & _
                     "VBScript error code: " & FORMAT$(CWRD(lError)) & $CRLF & strMsg
         ELSE
            strMsg = "Error code: " & HEX$(lError) & $CRLF & OBJRESULT$(lError)
         END IF
      END IF
   END IF

   IF strMsg = "" THEN strMsg = "Unknown error"
   FUNCTION = strMsg

END FUNCTION

' ########################################################################################