how to make an "include" activeX object in vb6 for vbscript?

Question

this is what i'm trying to make:

VB6 com.dll, name and classname: scripting.includefile

sub include(filepath)
ExecuteGlobal(CreateObject("SCRIPTING.FILESYSTEMOBJECT").OPENTEXTFILE("FILENAME, 1).READALL & vbNewLine)
End Sub

vbscript:

set x = createobject("scripting.includefile")
x.include "c:\test.vbs"
call sub_inside_test_vbs

is this possible? thanks in advance :)

Answer 1

If the crux of the issue here is including external script files into WSH scripts then you can simply stop writing your scripts as naked VBS files and write WSFs instead.

Assume these two files are in the same folder:

Utilities.vbs (Here we'll just have one Sub defined as a demo)

Option Explicit

Private Sub BubbleSort(ByRef ArrArrs, ByVal SortBy, ByVal Descending)
    'ArrArrs    is an array of arrays to sort.
    'SortBy     is the index of the element in each subarray
    '           to sort by.
    'Descending is a Boolean value.

    Dim FirstX
    Dim LastSwapX
    Dim LastX
    Dim X
    Dim Temp

    FirstX = LBound(ArrArrs)
    LastSwapX = UBound(ArrArrs)
    Do
        LastX = LastSwapX - 1
        LastSwapX = 0
        For X = FirstX To LastX
            Temp = ArrArrs(X)
            If (Temp(SortBy) > ArrArrs(X + 1)(SortBy)) Xor Descending Then
                ArrArrs(X) = ArrArrs(X + 1)
                ArrArrs(X + 1) = Temp
                LastSwapX = X
            End If
        Next
    Loop While LastSwapX
End Sub

DemoScript.wsf

<job>
<script language="VBScript" src="Utilities.vbs"/>
<script language="VBScript">
Option Explicit

Private AA
Private I
Private Msg

AA = Array(Array("Joe", "Rockhead", "56 Boulder Street"), _
           Array("Barney", "Rubble", "125 Rockaway Lane"), _
           Array("Fred", "Flintstone", "123 Rockaway Lane") _
          )
BubbleSort AA, 1, False
Msg = vbNullString
For I = LBound(AA) To UBound(AA)
    Msg = Msg & Join(AA(I), ", ") & vbNewLine
Next
WScript.Echo Msg
</script>
</job>

Answer 2

You just read a file with it and assign the text to the scripting control.

This is vbscript but vbscript is legal VB6.

Here I am reading a script from the command line and applying it to each line of stdin. Note I use the Script Control to check for syntax errors (you can't continue a program after a syntax error unlike runtime errors). I actually execute the script in vbscript (which VB6 can't do) rather than the script control to make passing data simple.

Set Arg = WScript.Arguments
set WshShell = createObject("Wscript.Shell")
Set Inp = WScript.Stdin
Set Outp = Wscript.Stdout

RawScript = Arg(1)
'Remove ^ from quoting command line and replace : with vbcrlf so get line number if error
Script = Replace(RawScript, "^", "")
Script = Replace(Script, "'", chr(34))
Script = Replace(Script, ":", vbcrlf)
'Building the script with predefined statements and the user's code
Script = "Dim gU" & vbcrlf & "Dim gdU" & vbcrlf & "Set gdU = CreateObject(" & chr(34) & "Scripting.Dictionary" & chr(34) & ")" & vbcrlf & "Function UF(L, LC)" & vbcrlf & "Set greU = New RegExp" & vbcrlf & "On Error Resume Next" & vbcrlf & Script & vbcrlf & "End Function" & vbcrlf

'Testing the script for syntax errors
On Error Resume Next
set ScriptControl1 = wscript.createObject("MSScriptControl.ScriptControl",SC)
    With ScriptControl1
        .Language = "VBScript"
        .UseSafeSubset = False
        .AllowUI = True
    .AddCode Script
End With
With ScriptControl1.Error
    If .number <> 0 then
        Outp.WriteBlankLines(1)
        Outp.WriteLine "User function syntax error"
        Outp.WriteLine "=========================="
        Outp.WriteBlankLines(1)
        Outp.Write NumberScript(Script)
        Outp.WriteBlankLines(2)
        Outp.WriteLine "Error " & .number & " " & .description
        Outp.WriteLine "Line " & .line & " " & "Col " & .column
        Exit Sub
    End If
End With

ExecuteGlobal(Script)

'Remove the first line as the parameters are the first line
'Line=Inp.readline  
Do Until Inp.AtEndOfStream
    Line=Inp.readline
    LineCount = Inp.Line 

    temp = UF(Line, LineCount)
    If err.number <> 0 then 
        outp.writeline ""
        outp.writeline ""
        outp.writeline "User function runtime error"
        outp.writeline "==========================="
        Outp.WriteBlankLines(1)
        Outp.Write NumberScript(Script)
        Outp.WriteBlankLines(2)
        Outp.WriteLine "Error " & err.number & " " & err.description
        Outp.WriteLine "Source " & err.source

        Outp.WriteLine "Line number and column not available for runtime errors"
        wscript.quit
    End If
    outp.writeline temp
Loop
End Sub

Vbs

filter vbs "text of a vbs script"
filter vb "text of a vbs script"

Use colons to seperate statements and lines. Use single quotes in place of double quotes, if you need a single quote use chr(39). Escape brackets and ampersand with the ^ character. If you need a caret use chr(136).

The function is called UF (for UserFunction). It has two parameters, L which contains the current line and LC which contains the linecount. Set the results of the script to UF. See example.

There are three global objects available. An undeclared global variable gU to maintain state. Use it as an array if you need more than one variable. A Dictionary object gdU for saving and accessing previous lines. And a RegExp object greU ready for use.

Example

This vbs script inserts the line number and sets the line to the function UF which Filter prints.

filter vbs "uf=LC ^& ' ' ^& L"<"%systemroot%\win.ini"

This is how it looks in memory

Dim gU
Set gdU = CreateObject("Scripting.Dictionary")
Set greU = New RegExp
Function UF(L, LC)

---from command line---
uf=LC & " " & L
---end from command line---

End Function

If there is a syntax error Filter will display debugging details.

User function syntax error

1 Dim gU
2 Dim gdU
3 Set greU = CreateObject("Scripting.Dictionary")
4 Function UF(L, LC)
5 On Error Resume Next
6 uf=LC dim & " " & L
7 End Function

Error 1025 Expected end of statement
Line 6 Col 6

User function runtime error

1 Dim gU
2 Dim gdU
3 Set greU = CreateObject("Scripting.Dictionary")
4 Function UF(L, LC)
5 On Error Resume Next
6 uf=LC/0 & " " & L
7 End Function

Error 11 Division by zero
Source Microsoft VBScript runtime error
Line number and column not available for runtime errors

Other examples

Reverse each line

filter vbs "uf=StrReverse^(L^)"<"%systemroot%\win.ini"