Shell 获取 返回（输出文本）

时　间:2018-02-08 10:10:05
作　者:litao   ID：37995  城市：上海
摘　要:很多时候，我们调用Shell 执行命令行，需要获取其返回的输出文本，判断执行情况。
下面是一个类模块代码：
IWshRuntimeLibrary 需要引用【Windows Script Host Object Model】
正　文:

很多时候，我们调用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