VBScript的權限提升

我們運行Dynamics GP。由於存儲表單/報告的方式，我需要一些將.SET文件複製到程序目錄的安裝腳本。這可以手動完成，但只需要用戶運行安裝程序腳本，爲他們安裝適當的文件就快得多。VBScript的權限提升

我一直在構建一個複製必要文件的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機器在啓動腳本時彈出一個神祕的「Run As」對話框。

這是我到目前爲止有：

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而不是？

來源

2012-11-08 db2

似乎是這樣做的最簡單的方法。

檢查操作系統版本。
如果它不是XP或2003（我沒有預料到這會在較舊的版本上運行），請用高程重新執行。

下面的代碼塊我添加到腳本的開頭：

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

來源

2012-11-09 13:26:46 db2

看起來你自己回答，但如果當前登錄用戶，而不是贏版管理員權限，我就考了，如果只提高需要。 –

改進對@ DB2答案：

真正海拔測試，而不依賴於傳遞的參數
將所有原始參數傳遞給提升腳本
使用初始腳本的相同主機：wscript.exe，cscript.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

來源

2016-01-07 02:07:29

VBScript的權限提升

回答

相關問題