你好，我的一个客户有很多 VBSripts (VBS)，可以做各种各样的事情。在每个脚本的顶部，他们引用了一个子库和函数库，如下所示:
Const ForReading = 1
Dim objFSO, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("Z:\path\VbsProcedures.vbs", ForReading)
Execute objFile.ReadAll()
'more code that uses the subs and functions in VbsProcedures.vbs
这样子和函数就可以在行下面的代码中使用了。这一切都很好。我可以在一个地方处理所有程序。问题是，当 VbsProcedures.vbs 中的过程产生错误时，我没有得到行号来帮助我调试它。我只返回第 0 行字符 1，或类似的东西。
在这种情况下如何获取错误行号？
我想知道是否有一个简单的解决方案。
我可以将 If Err.Number <> 0 Then 放在每个可疑行之后，并回显这样的错误描述 https://technet.microsoft.com/en-us/library/ee692852.aspx ，但这似乎效率很低。您不能像在 VBA 中那样使用 VBS 中的 GoTo somelabel 语句来处理大块代码的错误。
编辑:我无法发布 VbsProcedures.vbs，因为它是我的客户。我正在寻找该问题的通用解决方案，以便总体上可以更好地进行调试。我现在不是在寻求调试特定问题的帮助。事实上，现在没有错误。一般来说，VbsProedures.vbs里面就是我们使用的例程Functions和Subs。像这样:
Option Explicit
'create formatted dates easily
Function sfFormatDate(sDateOld, sFormat)
'code omitted
sfFormatDate = sDateNew
End Function
'progress type of message
Function fScriptIsRunningNoticeStart()
'code omitted
fScriptIsRunningNoticeStart = objExplorer
End Function
TEMP EDIT2:(尝试 BuvinJ 的建议。)
我想我终于让它工作了......
文件test.vbs的内容:
'Option Explicit
Const bINJECT_LOGGING=True
Sub Include( sRelativeFilePath )
' Get the library script
Dim oFs : Set oFs = CreateObject("Scripting.FileSystemObject")
Dim sThisFolder : sThisFolder = oFs.GetParentFolderName( WScript.ScriptFullName )
Dim sAbsFilePath : sAbsFilePath = oFs.BuildPath( sThisFolder, sRelativeFilePath )
Dim sLibrary : sLibrary = oFs.OpenTextFile( sAbsFilePath ).readAll()
' Perform compilation debugging
On Error Resume Next
Dim oSC : Set oSC = CreateObject("MSScriptControl.ScriptControl")
With oSC
.Language = "VBScript"
.UseSafeSubset = False
.AllowUI = False
.AddCode sLibrary
End With
With oSC.Error
If .Number <> 0 then
WScript.Echo sAbsFilePath & "(" & .Line & "," & .Column & ")" & _
" Microsoft VBScript compilation error: " & _
"(" & .Number & ") " & .Description
WScript.Quit
End If
End With
On Error Goto 0
' Implement optional runtime debugging via logging injections
If bINJECT_LOGGING Then
InjectRoutineLogging sLibrary, _
oFs.OpenTextFile( sAbsFilePath ), sRelativeFilePath
End If
' Import the Library
ExecuteGlobal sLibrary
End Sub
Sub InjectRoutineLogging( ByRef sLibrary, ByRef oFile, sFilePath )
sLibrary = ""
Dim sLine, sParseLine, sAppendLine, sPrependLine
Dim bIsRoutineBody : bIsRoutineBody = False
Dim sRoutineName : sRoutineName = ""
Dim aStartKeywords : aStartKeywords = Array( "SUB", "FUNCTION" )
Dim aEndKeywords : aEndKeywords = Array( "END SUB", "END FUNCTION" )
Do Until oFile.AtEndOfStream
sLine = oFile.ReadLine
sParseLine = Trim(sLine)
sPrependLine = ""
sAppendLine = ""
' Find routine signature starts (and the save name)
If sRoutineName = "" Then
For Each sKeyword In aStartKeywords
If Left( UCase(sParseLine), Len(sKeyword) ) = sKeyword Then
sParseLine = Right( sParseLine, _
Len(sParseLine)-Len(sKeyword) )
sRoutineName = Trim(Split( sParseLine, "(" )(0))
End If
Next
End If
If sRoutineName <> "" Then
If Not bIsRoutineBody Then
' Find end of routine signature
' (figuring in line continuations and eol comments)
' Inject start log
sParseLine = Trim(Split(sParseLine, "'")(0))
If Right( sParseLine, 1 ) = ")" Then
sAppendLine = "WScript.Echo" & _
"""Start " & sRoutineName & _
" (" & sFilePath & ")..." & """" & vbCrLF
bIsRoutineBody = True
End If
Else
' Find routine end
' Inject end log
For Each sKeyword In aEndKeywords
If Left( UCase(sParseLine), Len(sKeyword) ) = sKeyword Then
sPrependLine = "WScript.Echo ""...End " & _
sRoutineName & " "" "
sRoutineName = ""
bIsRoutineBody = False
End If
Next
End If
End If
' Append lines
If sPrependLine <> "" Then sLibrary = sLibrary & sPrependLine & vbCrLF
sLibrary = sLibrary & sLine & vbCrLF
If sAppendLine <> "" Then sLibrary = sLibrary & sAppendLine & vbCrLF
Loop
End Sub
WScript.Echo "test1"
Include "test_VbsProcedures.vbs" '"Z:\mypath\test_VbsProcedures.vbs"
WScript.Echo "test2"
call test_sub
WScript.Echo "test3"
文件 test_VbsProcedures.vbs 的内容是:
sub test_sub()
WScript.Echo "test_sub"
end sub
在cmd提示符下使用命令:
"C:\Windows\SysWOW64\cscript.exe" "Z:\mypath\test.vbs"
我得到:
test1
test2
Start test_sub (test_VbsProcedures.vbs)...
test_sub
...End test_sub
test3
非常感谢您对 BuvinJ 的帮助!让我知道这里是否还有更多工作要做，但我认为它正在运行!接下来我会打破它来测试它。
编辑 3:如果库有这个:
option explicit
sub test_sub()
msgbox "testing msg"
WScript.Echo "test_sub"
s = 1
end sub
sub stack1()
call test_sub()
end sub
我得到:
test1
test2
Start stack1 (test_VbsProcedures.vbs)...
Start test_sub (test_VbsProcedures.vbs)...
test_sub
Z:\mypath\test.vbs(0,
1) Microsoft VBScript runtime error: Variable is undefined: 's'
...所以看起来错误行号是 (0,1)，这是不正确的。
编辑 4:使用 lib 作为:
option explicit
sub test_sub()
msgbox "testing msg"
WScript.Echo "test_sub"
's = 1
dim x : x=(1
end sub
sub stack1()
call test_sub()
end sub
行号现在有效!!
test1
Z:\mypath\test_VbsProcedures.vbs(11,12) Microsoft VBScript compilation error: (1006) Expected ')'
test1
最佳答案
您不会获得运行时错误的行号
它不是用来加载库的。
这会检查语法。
Sub VBSCmd
RawScript = LCase(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
这里有帮助
filter vbs "text of a vbs script"
filter vb "text of a vbs script"
使用冒号分隔语句和行。使用单引号代替双引号，如果您需要单引号，请使用 chr(39)。使用 ^ 字符转义括号和符号。如果您需要插入符号，请使用 chr(136)。
该函数称为 UF(对于 UserFunction)。它有两个参数，包含当前行的 L 和包含行数的 LC。将脚本的结果设置为 UF。参见示例。
共有三个全局对象可用。一个未声明的全局变量 gU 来维护状态。如果您需要多个变量，请将其用作数组。用于保存和访问前几行的字典对象 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 将显示调试详细信息。
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
其他例子
反转每一行
filter vbs "uf=StrReverse^(L^)"< "%systemroot%\win.ini"
每行小写
filter vbs "uf=LCase^(L^)"< "%systemroot%\win.ini"
每行大写
filter vbs "uf=UCase^(L^)"< "%systemroot%\win.ini"
给文件中的每一行编号
filter vbs "uf=LC ^& ' ' ^& L"< "%systemroot%\win.ini"
转到页面顶部
关于vbscript - 如何从通过 VBS 读取或通过 ReadAll 引用的子程序中获取行错误？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/29850561/