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 :)

`ExecuteGlobal` is a statement, it's not a method of an object that can be accessed by VB6 code. The only option is to keep the `include` function implementation in VBScript. — wqw, Nov 16 '14 at 12:22

score 1 · Answer 1 · answered Nov 16 '14 at 00:53

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"

noodlesstillalive, "I actually execute the script in vbscript (which VB6 can't do)" that's all i needed to know :), so it's not possible with vb6. i wanted to make a simple activeX dll that executeglobal's a file inside a vbscript and first i thought "maybe it's possible with a scriptcontrol inside vb6 class" but that also was not possible as you saw. — Tom, Nov 16 '14 at 01:19
I think instead of saying implementation say what you want. Forget languages etc. Just explain the end state and what's required of it. I have a scriptcontrol providing vbscript macros in a VB6 word processor. If I share a VB6 form (a form is an object) vbscript macros can access all functions on that form. — , Nov 16 '14 at 01:25
if i understand you correctly you firstly ask why or for what i'm trying to do this right? i write vbscripts all the time and sometimes the code is VERRY large, — Tom, Nov 16 '14 at 01:35
so sometimes i split the large script into smaller vbscript's, put them into a folder and make a main script that reads everything in that folder and executes what's in the scripts. in the main file there is a sub called "include" (see example in my question) so that i can include files like in e.g. c++ ore something. the problem is that every time i do this i have to write that same "include" sub in the main vbscript so i wondered if i can make an activeX dll in vb6 so that i just can do this: createobject("blah.include").include "filepath"... — Tom, Nov 16 '14 at 01:35
These are references on what we are talking about. http://blogs.msdn.com/b/ericlippert/archive/2003/09/20/53058.aspx the programmer that added the commands to vbscript. Same person talking about eval in jscript in part 1 of 3 parts. http://blogs.msdn.com/b/ericlippert/archive/2003/11/01/53329.aspx — , Nov 16 '14 at 01:59
You just need to executeglobal on the file contents. `Set srcfile = fso.GetFile("c:\something.vbs"):Set TS = srcFile.OpenAsTextStream(1, 0):executeglobal(ts.readall)` — , Nov 16 '14 at 02:05
i need to executeglobal on the file contents, but i wanted to know if its possible to write an activeX dll for doing that :) — Tom, Nov 16 '14 at 02:11
I know, thats what i did all the time. thanks noodlesstillalive. regards — Tom, Nov 16 '14 at 02:22

score 1 · Answer 2 · answered Nov 16 '14 at 18:34

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>

interesting idea, i have to start learning XML i guess, thanks Bob77 — Tom, Nov 16 '14 at 18:55
The XML required is minimal, and pretty well documented in the WSH docs. As a bonus you can use it to instantiate objects (FSO, etc.) as well as to reference type libraries to import constants into the script's namespace. See http://msdn.microsoft.com/en-us/subscriptions/x4d5a2tx(v=vs.84).aspx — Bob77, Nov 16 '14 at 19:19

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

2 Answers2

User function syntax error

User function runtime error

Linked