很多时候,我们调用Shell 执行命令行,需要获取其返回的输出文本,判断执行情况。
下面是一个类模块代码:
IWshRuntimeLibrary 需要引用【Windows Script Host Object Model】
Option Compare Database '--Shell执行类
Option Explicit
Private Const TempDir_ As String = "Temp" '临时文件存储目录
Private Const FileHead As String = "Shl" '临时文件头
Private Sub Class_Terminate() '退出
Dim fso As New Scripting.FileSystemObject
fso.DeleteFile Me.TempDir & "\" & FileHead & "*.*"
Set fso = Nothing
End Sub
'====可用方法====
Public Function TempDir() As String
TempDir = CurrentProject.Path & "\" & TempDir_
If Dir(TempDir, vbDirectory) = "" Then
MkDir TempDir '新建子文件夹
End If
End Function
Public Function Run(CMD As String) As Long '执行 等待结果
On Error GoTo err1
Dim oShell As IWshRuntimeLibrary.WshShell
Set oShell = CreateObject("WScript.Shell")
Run = oShell.Run(CMD, 0, True)
Set oShell = Nothing
Exit Function
err1:
MsgBox "Run 错误!" & Chr(13) & "CMD:" & CMD & Chr(13) & "ERR:" & err.Description
End Function
Public Function Exec(CMD As String) As Scripting.Dictionary '执行 获取返回文本的词典
On Error GoTo err1
Dim fso As New Scripting.FileSystemObject
Dim TF As TextStream, i As Long
Dim TmpP As String, BatPF As String, LogPF As String, Name As String
TmpP = Me.TempDir
loop1:
Name = FileHead & Format(Int((99999 * Rnd) + 1), "00000")
BatPF = TmpP & "\" & Name & ".*"
If Dir(BatPF) <> "" Then GoTo loop1
BatPF = TmpP & "\" & Name & ".bat"
LogPF = TmpP & "\" & Name & ".log"
'--创建BAT文件
Set TF = fso.CreateTextFile(BatPF, True) '新建文件
If TF Is Nothing Then GoTo err1
Call TF.Write(CMD)
TF.Close
'--执行BAT文件
Dim CMDstr As String
CMDstr = """" & BatPF & """ >> """ & LogPF & """"
Debug.Print CMDstr
Me.Run CMDstr
'--获取输出
Dim Dic As New Scripting.Dictionary
Set TF = fso.OpenTextFile(LogPF, ForReading, False, TristateMixed) '打开文件
If TF Is Nothing Then GoTo err1
'遍历文件
Do Until TF.AtEndOfStream
i = TF.Line
Dic.Add i, TF.ReadLine
'Debug.Print Dic(i)
Loop
Set Exec = Dic
TF.Close
'--删除临时文件
BatPF = TmpP & "\" & Name & ".*"
fso.DeleteFile BatPF
Set TF = Nothing
Set fso = Nothing
Exit Function
err1:
MsgBox "Exec 错误!" & Chr(13) & "CMD:" & CMD & Chr(13) & "ERR:" & err.Description
Set TF = Nothing
Set fso = Nothing
End Function
Public Function ExecIsRet(CMD As String, RetStr As String) As Boolean '执行 判断返回是否包含指定字符串
ExecIsRet = False
On Error GoTo err1
Dim Dic As Scripting.Dictionary, i As Long, Txt As String
Set Dic = Me.Exec(CMD)
If Dic Is Nothing Then Exit Function
For i = Dic.Count - 1 To 1 Step -1
Txt = Dic.Items(i)
If InStr(1, Txt, RetStr) > 0 Then
ExecIsRet = True
Exit For
End If
Next
Set Dic = Nothing
Exit Function
err1:
MsgBox "ExecIsRet 错误!" & Chr(13) & "CMD:" & CMD & Chr(13) & "ERR:" & err.Description
ExecIsRet = False
End Function