'Alan dot Kaplan at VA dot Gov 6/23/10
'This scriptlet shows you how run a vbscript with a UAC prompt
'and to permit choice of script host.  If OS pre-VISTA then UAC is ignored.

Option Explicit
Dim wshshell: Set WshShell = CreateObject("WScript.Shell")
Dim fso: Set FSO = CreateObject("Scripting.FileSystemObject")
'If WScript.Arguments.Count = 0 Then
'    Wscript.Echo "Перетащите библиотеку .DLL (.OCX) на этот скрипт" 
'    WScript.Quit
'end if

'0 Don't change host
'1 Run with Cscript
'2 Run with Wscript

ReRunUAC 2

'script continues...
'Demo code
WshShell.Popup(WshShell.CurrentDirectory&"\CryptoHelperActiveX.ocx")
FSO.CopyFile WshShell.CurrentDirectory&"\CryptoHelperActiveX.ocx","C:\windows\System32\", 1
WshShell.Run "regsvr32.exe ""C:\windows\System32\CryptoHelperActiveX.ocx""",0,False
WScript.Quit


Sub ReRunUAC(iHost)
	If isElevated Then Exit Sub 
	Dim quote: quote=chr(34)
	Dim oWMI:  Set oWMI = GetObject("winmgmts:\\.\root\cimv2")
	Dim oShell: Set oShell = CreateObject("Shell.Application")
	Dim iWindow: iWindow = 0 '1 normal 2 minimized.  0 is bad, hidden
	Dim oOSInfo, OS
	Dim strHost, strArgs, i
	Select Case iHost
		Case 0	'Don't change
			strHost =  wscript.FullName
		Case 1
			strHost = "Cscript.exe"
		Case 2
			strHost = "Wscript.exe"
		Case Else
			strHost = wscript.FullName
	End Select
	
	'Get list of arguments

	If WScript.Arguments.Count > 0 Then 
		For i = 0 To WScript.Arguments.Count-1
			strArgs =  strArgs & space(1) & WScript.Arguments(i)
		Next
	End If 
	'based in part on code at http://support.microsoft.com/kb/958149
	' On Vista and higher, handle UAC
	Set oOSInfo = oWMI.ExecQuery("SELECT version FROM Win32_OperatingSystem")
	For Each os in oOSInfo
	    If Int(Left(os.Version, 1)) >= 6  Then
	    	'pass a fake argument if none for shellexecute
	    	If  WScript.Arguments.length = 0 Then strArgs = ""
	        ' Use ShellExecute with runas verb to prompt for elevation
	        Set oShell = CreateObject("Shell.Application")    
	        oShell.ShellExecute strHost, quote & WScript.ScriptFullName & _
	            quote & space(1) & strArgs, "", "runas", iWindow
	        WScript.Quit(0)
	    Else ' OS is pre Vista
	    	'if host does not matter and no UAC, continue

	    	If iHost = 0 then Exit Sub 
	    	
	    	'if running as Wscript and choice is Cscript, rerun as Cscript
	    	If IsCScript = False And iHost = 1 Then 	    		
				WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote & space(1) & strArgs, iWindow, false
    			WScript.Quit(0)
			End If 
	    	'if running as Cscript and choice is Wscript, rerun as Wscript
	    	If IsCScript = True and iHost = 2 Then 
				WshShell.Run "Wscript.exe " & quote & WScript.ScriptFullName & quote & space(1) & strArgs, iWindow, false
    			WScript.Quit(0)
			End If 
	    End If
	    Exit For
	Next
End Sub 


Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function

Function isElevated ()'test whether user has elevated token  
	'based on http://stackoverflow.com/questions/235822/vbscript-detect-whether-uac-elevated
	Dim oExecWhoami, oWhoamiOutput, strWhoamiOutput
	Set oExecWhoami = wshShell.Exec("whoami /groups") 
	Set oWhoamiOutput = oExecWhoami.StdOut 
	strWhoamiOutput = oWhoamiOutput.ReadAll 
	If InStr(1, strWhoamiOutput, "S-1-16-12288", vbTextCompare) Then 
		isElevated = True 
	Else
		isElevated = False	
	End If 
End Function