VBScript的ShellExecute返回码

Question

是否有可能获得返回代码（Bool可能？）以了解UAC对话框是被接受还是被拒绝？我现在没有检查如下。

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

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

Answer 1

数十次说： basically, no, what you're asking isn't possible. 然而，有一种解决方法可以解决高可能性的问题，尽管仍有非零错误回应的概率。以下是此类解决方案的草稿，请参阅以下脚本：

• 如果已提升，则答案为100％：不需要UAC提示。
• 否则，在 UAC提示之前计算提升 wscript.exe ，在之后计算：
  • 如果计数器匹配则 UAC提示可能被拒绝;
  • 如果计数器不同，则 UAC提示可能已批准。

如果提升 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\SO\37911301.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\SO\37911301.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调用如果已升高对蚊子来说太重了......

Answer 2

虽然documentation建议否则ShellExecute实际上不会返回任何内容，因为该方法是异步运行的（即立即返回而不等待新进程终止）。可以使用Run和Exec方法在VBScript中进行同步调用，但这些方法不允许权限提升。

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