Permission elevation from VBScript

Question

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.

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.

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.

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.

Here's what I have so far:

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

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?

Answer 1

Improved on @db2 answer:

• real elevation testing, without depending on passed arguments
• passes all original arguments to the elevated script
• uses the same host of the initial script: wscript.exe, cscript.exe, whatever

Code:

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