如何制作"包括" vb6中的activeX对象是否为vbscript?

时间:2014-11-15 23:50:47

标签: object vbscript vb6 activex

这就是我想要做的事情:

VB6 com.dll,名称和类名: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
这可能吗? 提前谢谢:)

2 个答案:

答案 0 :(得分:1)

您只需使用它读取文件并将文本分配给脚本控件。

这是vbscript,但vbscript是合法的VB6。

这里我从命令行读取脚本并将其应用于stdin的每一行。注意我使用脚本控制来检查语法错误(与语法错误不同,您不能在运行时错误之后继续执行程序)。我实际上是在vbscript中执行脚本(VB6不能这样做)而不是脚本控件来简化传递数据。

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"

使用冒号分隔语句和行。使用单引号代替双引号,如果需要单引号,请使用chr(39)。使用^字符转义括号和&符号。如果你需要插入符号,请使用chr(136)。

该函数称为UF(用于UserFunction)。它有两个参数,L包含当前行,LC包含linecount。将脚本的结果设置为UF。见例。

有三个全局对象可用。未声明的全局变量gU,用于维护状态。如果需要多个变量,请将其用作数组。用于保存和访问前一行的Dictionary对象gdU。并且可以使用RegExp对象greU。

示例

此vbs脚本插入行号并将行设置为过滤器打印的函数UF。

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

这就是它在内存中的样子

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

如果存在语法错误,Filter将显示调试详细信息。

用户函数语法错误

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

用户功能运行时错误

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

其他示例

反转每一行

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

答案 1 :(得分:1)

如果问题的关键在于将外部脚本文件包含到WSH脚本中,那么您可以简单地停止将脚本编写为裸VBS文件并改为编写WSF。

假设这两个文件位于同一文件夹中:

Utilities.vbs (这里我们只将一个Sub定义为演示)

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>