VBScript的权限提升

时间:2012-11-08 19:27:09

标签: windows-7 vbscript

我们运行Dynamics GP。由于它存储表单/报表的方式,我需要一些安装脚本将.SET文件复制到程序目录中。这可以手动完成,但只需让用户运行安装程序脚本就可以更快地安装适当的文件。

我一直在构建一个复制必要文件的VBScript安装程序。棘手的部分是一些客户端运行的是Windows XP,有些运行的是Windows 7(甚至是8)。 UAC已启用,因此权限发挥作用。

我尝试这样做的方法是盲目地尝试复制文件,如果检测到权限错误,它会使用管理员权限重新启动脚本。我们遇到问题的是一些(所有?)Windows 7计算机启用了虚拟化文件/注册表写入,因此当脚本尝试将文件复制到C:\ Program Files \ Microsoft Dynamics \ GP2010时,它会无声地失败并复制它们到用户的AppData \ Local \ VirtualStore目录。这对GP无效。

所以我需要做的是让脚本将文件复制到C:\ Program Files(而不是VirtualStore目录),并仅在必要时提升权限。如果我让它全面提升,这会导致Windows XP机器在启动脚本时简单地弹出一个神秘的“运行方式”对话框。

这是我到目前为止所拥有的:

Dim WSHShell, FSO, Desktop, DesktopPath
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSHShell = CreateObject("WScript.Shell")
Desktop = WSHShell.SpecialFolders("Desktop")
DesktopPath = FSO.GetAbsolutePathName(Desktop)

'Set working directory to directory the script is in.
'This ends up being C:\Windows\System32 if the script is
'started from ShellExecute, or a link in an email, thus breaking
'relative paths.
WSHShell.CurrentDirectory = FSO.GetFile(WScript.ScriptFullName).ParentFolder

On Error Resume Next

If FSO.FolderExists("C:\Program Files (x86)") Then
    WScript.Echo "Installing 64-bit."
    FSO.CopyFile "64-bit\*.set", "C:\Program Files (x86)\Microsoft Dynamics\GP2010\", True
    FSO.CopyFile "64-bit\*.lnk", DesktopPath, True
ElseIf FSO.FolderExists("C:\Program Files\Microsoft Dynamics\GP2010\Mekorma MICR") Then
    WScript.Echo "Installing 32-bit (with MICR)."
    FSO.CopyFile "32-bit MICR\*.set", "C:\Program Files\Microsoft Dynamics\GP2010\", True
    FSO.CopyFile "32-bit MICR\*.lnk", DesktopPath, True 
Else
    WScript.Echo "Installing 32-bit."
    FSO.CopyFile "32-bit\*.SET", "C:\Program Files\Microsoft Dynamics\GP2010\", True
    FSO.CopyFile "32-bit\*.lnk", DesktopPath, True
End If

If Err.Number = 70 Then
    CreateObject("Shell.Application").ShellExecute "wscript.exe", """" & WScript.ScriptFullName & """" , "", "runas", 1
    WScript.Quit
ElseIf Err.Number <> 0 Then
    MsgBox "Error " & Err.Number & vbCrLf & Err.Source & vbCrLf & Err.Description
Else
    MsgBox "Installed successfully."
End If

总结:如何让VBScript提升权限而不导致XP在“运行方式”对话框中停止,而没有导致Windows 7复制而是将文件改为AppData \ Local \ VirtualStore?

2 个答案:

答案 0 :(得分:4)

改进@ db2答案:

  • 真正的高程测试,不依赖于传递的参数
  • 将所有原始参数传递给提升脚本
  • 使用初始脚本的相同主机:wscript.execscript.exe,无论

<强>代码:

Set OSList = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
For Each OS In OSList
    If InStr(1, OS.Caption, "XP") = 0 And InStr(1, OS.Caption, "Server 2003") = 0 Then
        With CreateObject("WScript.Shell")
            IsElevated = .Run("cmd.exe /c ""whoami /groups|findstr S-1-16-12288""", 0, true) = 0
            If Not IsElevated Then
                Dim AllArgs
                For Each Arg In WScript.Arguments
                    If InStr( Arg, " " ) Then Arg = """" & Arg & """"
                    AllArgs = AllArgs & " " & Arg
                Next
                Command = """" & WScript.ScriptFullName & """" & AllArgs
                With CreateObject("Shell.Application")
                    .ShellExecute WScript.FullName, " //nologo " & Command, "", "runas", 1
                    WScript.Echo WScript.FullName & " //nologo " & Command
                End With
                WScript.Quit
            End If
        End With
    End If
Next

' Place code to run elevated here

答案 1 :(得分:2)

似乎这是最简单的方法。

  1. 检查操作系统版本。
  2. 如果它不是XP或2003(我预计这不会在旧版本上运行),请以高程重新执行。
  3. 这是我添加到脚本开头的代码块:

    Dim OSList, OS, UAC
    UAC = False
    If WScript.Arguments.Count >= 1 Then
        If WScript.Arguments.Item(0) = "elevated" Then UAC = True
    End If
    
    If Not(UAC) Then
        Set OSList = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
        For Each OS In OSList
            If InStr(1, OS.Caption, "XP") = 0 And InStr(1, OS.Caption, "Server 2003") = 0 Then
                CreateObject("Shell.Application").ShellExecute "wscript.exe", """" & WScript.ScriptFullName & """ elevated" , "", "runas", 1
                WScript.Quit
            End If
        Next
    End If