|
|
本帖最后由 山中老人 于 2019-3-16 11:25 编辑
WScript.Shell 的 Run 可以隐藏没有办法获取输出；Exec 可以获取输出没有办法隐藏。
这真是个操蛋的事情，为了解决这个问题。找了几种办法都有问题。
用API管道：会不定期卡死在【ReadFile(hRead, sBuffer(0), 64, lgSize, ByVal 0&)】这个步骤上，导致程序崩溃！ 还有API管道经常遭到杀毒软件拦截
用WScript 的Run与Exec组合：在VBA中无法获取到WScript对象。
最后只好使用DOS的重定向输出，把输出文本写入到一个文件，再从文件中获取。
下面是演示代码：
RunStr：执行命令，获取输出文本
RunBatStr：批处理封装执行命令，获取输出文本（由于重定向会干扰部分命令的参数，需要使用批处理文件封装命令）
Public Function Run(ByVal CMD As String, Optional ByVal ErrVisible As Boolean = True) As Long '执行 等待结果
Run = 0
On Error GoTo err1
Dim SubName As String, SubTxt As String
SubName = "Run"
SubTxt = "执行等待结果" '
Dim oShell As IWshRuntimeLibrary.WshShell
Set oShell = CreateObject("WScript.Shell")
Run = oShell.Run(CMD, 0, True)
Set oShell = Nothing
Exit Function
err1:
' If ErrVisible Then Call ErrMsBox(ERR, SubName, SubTxt & " 失败!" & Chr(13) & CMD)
End Function
Public Function RunStr(ByVal CMD As String, Optional ByVal ErrVisible As Boolean = True) As String '执行 获取返回文本
On Error GoTo err1
Dim SubName As String, SubTxt As String
SubName = "RunStr"
SubTxt = "执行，获取返回" '
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 = Environ("TEMP")
'--设置临时文件
loop1:
Name = RndStr(8, 2) '临时文件名
LogPf = TmpP & "\" & Name & ".log"
If Dir(LogPf) <> "" Then GoTo loop1
'执行
Dim CMDStr As String
CMDStr = CMD & " > """ & LogPf & """"
' Debug.Print CMDStr
Run CMDStr, ErrVisible '执行
'--获取输出
Set TF = fso.OpenTextFile(LogPf, ForReading, False, TristateMixed) '打开输出文件
If TF Is Nothing Then GoTo err1
RunStr = TF.ReadAll
TF.Close
'--删除临时文件
On Error Resume Next
If fso.FileExists(LogPf) Then fso.DeleteFile LogPf
Set TF = Nothing
Set fso = Nothing
Exit Function
err1:
' If ErrVisible Then Call ErrMsBox(ERR, SubName, SubTxt & " 失败!" & Chr(13) & CMD)
Set TF = Nothing
Set fso = Nothing
End Function
Public Function RunBatStr(ByVal CMDs As String, Optional ByVal ErrVisible As Boolean = True) As String '执行 获取返回文本
On Error GoTo err1
Dim SubName As String, SubTxt As String
SubName = "RunBatStr"
SubTxt = "批处理封装执行，获取返回" '
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 = Environ("TEMP")
'--设置临时文件
loop1:
Name = RndStr(8, 2) '临时文件名
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(CMDs)
TF.Close
'--执行BAT文件
Dim CMDStr As String
CMDStr = """" & BatPF & """ >> """ & LogPf & """"
'Debug.Print CMDstr
Run CMDStr, ErrVisible '执行
'--获取输出
Set TF = fso.OpenTextFile(LogPf, ForReading, False, TristateMixed) '打开输出文件
If TF Is Nothing Then GoTo err1
RunBatStr = TF.ReadAll
TF.Close
'--删除临时文件
On Error Resume Next
fso.DeleteFile TmpP & "\" & Name & ".*"
Set TF = Nothing
Set fso = Nothing
Exit Function
err1:
' If ErrVisible Then Call ErrMsBox(ERR, SubName, SubTxt & " 失败!" & Chr(13) & CMDs)
Set TF = Nothing
Set fso = Nothing
End Function
Public Function RndStr(ByVal Length As Long, ByVal Level As Long) As String
'Length=字符长度
'Level=字符等级。1级=数字，2级=数字+小写字母，3级=数字+大小写字母，4级=数字+大小写字母+符号
On Error GoTo err1
Dim SubName As String, SubTxt As String
SubName = "RndStr"
SubTxt = "取随机字符串"
If Length < 1 Then Exit Function
Dim allstr As String, substr As String, Txt As String, i As Long
allstr = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%^&*()"
Select Case Level
Case 1
i = 10
Case 2
i = 36
Case 3
i = 62
Case Else
i = Len(allstr)
End Select
substr = Left(allstr, i)
' Debug.Print substr
Txt = ""
For i = 1 To Length
Txt = Txt & Mid(substr, Int(Rnd * i + 1), 1)
Next
RndStr = Txt
Exit Function
err1:
' Call ErrMsBox(ERR, SubName, SubTxt & " 失败!")
End Function
|
评分
-
2
查看全部评分
-
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2019-3-15 10:26
楼主
