从 VBScript 提升权限 [英] Permission elevation from VBScript

问题描述

我们运行 Dynamics GP.由于它存储表单/报告的方式，我需要一些安装脚本将 .SET 文件复制到程序目录中.这可以手动完成，但让用户运行安装程序脚本来为他们​​安装适当的文件会快得多.

We run Dynamics GP. Because of the way it stores forms/reports, I need to have some install scripts that copy a .SET file into the program directory. This can be done manually, but it's much quicker to just have a user run an installer script which installs the proper files for them.

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

I've been building a VBScript installer that copies the necessary files around. The tricky part is that some clients are running Windows XP, and some are running Windows 7 (or even 8). UAC is enabled, so permissions come into play.

我尝试这样做的方法是盲目地尝试复制文件，如果检测到权限错误，它会以管理员权限重新启动脚本.我们遇到问题的地方是一些(全部?)Windows 7 机器启用了虚拟化文件/注册表写入，因此当脚本尝试将文件复制到 C:\Program Files\Microsoft Dynamics\GP2010 时，它会默默地失败并复制它们到用户的 AppData\Local\VirtualStore 目录.这在 GP 中无法正常工作.

The way I've tried to do it is by blindly attempting to copy the files, and if a permission error is detected, it relaunches the script with administrator permissions. Where we've run into problems is some (all?) Windows 7 machines have virtualized file/registry writes enabled, so when the script tries to copy files into C:\Program Files\Microsoft Dynamics\GP2010, it silently fails and copies them to the user's AppData\Local\VirtualStore directory. This doesn't work properly with GP.

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

So what I need to do is have the script copy the files to C:\Program Files (not the VirtualStore directory), and elevate permissions only if necessary. If I have it elevate across the board, this causes the Windows XP machines to simply pop up a cryptic "Run As" dialog box when launching the script.

这是我目前所拥有的:

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?

In summary: How do I have a VBScript elevate permissions without causing XP to stall at a "Run As" dialog box, and without causing Windows 7 to copy the files to AppData\Local\VirtualStore instead?

推荐答案

似乎这是最简单的方法.

Seems like this is the simplest way to do it.

1. 检查操作系统版本.
2. 如果它不是 XP 或 2003(我预计它不会在任何更旧的版本上运行)，请重新执行提升.

这是我添加到脚本开头的代码块:

Here's the code block I added to the beginning of the script:

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

这篇关于从 VBScript 提升权限的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！