VBScript 的 ShellExecute return 代码

VBScript's ShellExecute return codes

是否有可能使用 return 代码(可能是布尔值?)来了解 UAC 对话框是被接受还是被拒绝?我现在不检查就做了如下。

Set Shell = CreateObject("Shell.Application")
Shell.ShellExecute "wscript.exe", """" & SOME_LOG_PARSING_SCRIPT_FULLPATH_HERE & """ uac", "", "runas"

我很高兴知道用户是否接受了 uac 对话框(如果有的话)。

虽然有 documentation suggests otherwise ShellExecute doesn't actually return anything, because the method runs asynchronously (i.e. returns immediately without waiting for the new process to terminate). Synchronous calls in VBScript can be made with the Run and Exec 方法,但这些方法不允许提升权限。

基本上,不,你问的是不可能的。

几十次说: 然而,有一个解决方法可以高可能性回答问题,尽管有仍然是 错误响应的非零概率 。这是此类解决方案的草稿,请参阅以下脚本:

  • 如果已经提升那么答案是 100%:不需要 UAC 提示
  • 否则,计数 提升 wscript.exe UAC 提示和之后它:
    • 如果计数器匹配,则 UAC 提示被可能拒绝
    • 如果计数器不同,则 UAC 提示 可能 已批准

如果 elevated wscript.exe 异步启动或同时完成……例如,从 RDP 会话或任务调度程序等

option explicit
On Error GoTo 0
Dim strResult: strResult = Wscript.ScriptName

Dim objShell, svcCounter, preCounter, postCounter
Set objShell = CreateObject("Shell.Application")

svcCounter  = 0
preCounter  = 0
postCounter = 0

Call TestProcess ( "SVC", svcCounter, "svchost.exe" )
strResult = strResult & vbNewLine & Cstr( svcCounter)

If svcCounter  = 0 Then
    '' elevated already
    strResult = strResult & vbNewLine & "UAC prompt not required"
    objShell.ShellExecute "wscript.exe" _
        , """" & "D:\VB_scripts\SO911301.vbs" & """ uac" , "", "runas", 1
Else
    preCounter  = 0

    Call TestProcess ( "pre", preCounter, "wscript.exe" )

    ' By default, Windows Vista/7/8's UAC prompt is shown on a _secure desktop_
    ' suspending calling process temporarily:
    objShell.ShellExecute "wscript.exe" _
        , """" & "D:\VB_scripts\SO911301.vbs" & """ uac" , "", "runas", 1

    Call TestProcess ( "post", postCounter, "wscript.exe" )

    strResult = strResult & vbNewLine & Cstr( preCounter) & vbTab & Cstr( postCounter)
    If preCounter = postCounter Then
        strResult = strResult & vbNewLine & "UAC prompt PROBABLY refused" 
    Else
        strResult = strResult & vbNewLine & "UAC prompt PROBABLY approved"
    End If
End If

Wscript.Echo strResult
Wscript.Quit

Sub TestProcess( byVal sStage, byRef nCounter, byVal strCap)

  strResult = strResult & vbNewLine & sStage 
  Dim strQuery, objWMIService, colItems, objItem, sCaption, sCmdLine
  Const wbemFlagReturnImmediately = &h10
  Const wbemFlagForwardOnly       = &h20

  strQuery = "SELECT * FROM Win32_Process WHERE Caption = '" & strCap & "'"

  Set objWMIService = GetObject("winmgmts:\" & "." & "\ROOT\CIMV2")
  Set colItems = objWMIService.ExecQuery(strQuery _
          , "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)

  For Each objItem in colItems
      sCaption = objItem.Caption
      sCmdLine = objItem.CommandLine
      if VarType( sCmdLine ) = 1 Then nCounter = nCounter + 1  'Null => elevated
      strResult = strResult & vbNewLine & sCaption
      strResult = strResult & vbTab & objItem.ProcessId
      strResult = strResult & vbTab & sCmdLine
      'strResult = strResult & vbTab & VarType( sCmdLine ) & vbTab & TypeName( sCmdLine )
  Next
End Sub

请注意,所有带有 strResult 的垃圾内容仅用于调试目的。而且……我知道 TestProcess 调用用于测试如果已经升高 对蚊子来说太重了……