/build/static/layout/Breadcrumb_cap_w.png

Windows 7 - UAC and Application Deployment using VB Script

One of the biggest challenges with Windows 7 is getting software installed with UAC enabled and the user is not an local administrator.  I found a VB script a few years ago that helped assist with just that. This VB Script is a very powerful asset in any IT organization.  I utilize it as a shell for all VB Scripts I write. I wish I could remember the original author(s) to give credit where credit is due.  I believe I stumbled upon it through Google Searches and several random forum boards.  Trying and experimenting with as many possible solutions as I could find.

'---------------------------------------------
'Run a VB Script after forcing a UAC challenge
'2/10/2012 Trinity Rolling
'-------------------------------------------- 
bElevate = False
if WScript.Arguments.Count > 0 Then If WScript.Arguments(WScript.Arguments.Count-1) <> "|" then bElevate = True
if bElevate Or WScript.Arguments.Count = 0 Then ElevateUAC
'--------------------------------------------
'Insert the script you want to run with elevated privledges below
'--------------------------------------------

' Check the operating system
Function IsWindows7
Set OSSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" _
& "./root/cimv2").ExecQuery("select Caption from Win32_OperatingSystem")
For Each OS In OSSet
sOS = OS.Caption
Next
IsWindows7 = (InStr(1, sOS, "Windows 7", 1) + InStr(1, sOS, "Vista") > 0)
End Function
' Force a UAC challenge
Sub ElevateUAC
if not isWindows7 then Exit Sub
sParms = " |"
If WScript.Arguments.Count > 0 Then
For i = WScript.Arguments.Count-1 To 0 Step -1
sParms = " " & WScript.Arguments(i) & sParms
Next
End If
Set oShell = CreateObject("Shell.Application")
oShell.ShellExecute "wscript.exe", WScript.ScriptFullName & sParms, , "runas", 1
WScript.Quit
End Sub

Below is an example of the script used to deploy Microsoft Lync 2010 to Field Agents at their convienence.  Field Agents are a challenge as they may require VPN, low bandwidth, and short attention spam.

'---------------------------------------------
'Run a VB Script after forcing a UAC challenge
'2/10/2012 Trinity Rolling
'--------------------------------------------
bElevate = False
if WScript.Arguments.Count > 0 Then If WScript.Arguments(WScript.Arguments.Count-1) <> "|" then bElevate = True
if bElevate Or WScript.Arguments.Count = 0 Then ElevateUAC

' Check for Software Title
'This script outputs to a .tsv file a list of applications installed on the computer
'Output file is software.tsv
'Usage: cscript applications.vbs

'----------------------------------------
softwareTitle = "Microsoft Lync 2010" 'Change the software title you are looking for here.
softwareVersion = "4.0.7577.0" 'Change the software version you are looking for here.
InstallScript = "C:\Updates\LyncInstall.cmd"
strTargetFolder = "C:\Updates\"
strSourceFolder = "\\FileShare\DeploymentShare\Applications\Lync\i386\"
strInstallFile1 = "LyncSetup.exe"
strInstallFile2 = "" 'Uncomment the lines below (100-103) if used.
strInstallFile3 = "" 'Uncomment the lines below (104-107) if used.
strInstallFolder1 = "" 'Uncomment the lines below (108-111) if used.

'----------------------------------------

'Begin Script Execution

Set objShell = CreateObject("WScript.Shell")
objShell.Popup "We are now checking for existing versions. This notification will disappear once we have finished checking for existing versions. Please wait... ", 60, softwareTitle, 64
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile("C:\WINDOWS\Temp\software.tsv", True)

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery _
("Select * from Win32_Product")

objTextFile.WriteLine "Caption" & vbtab & _
"Description" & vbtab & "Identifying Number" & vbtab & _
"Install Date" & vbtab & "Install Location" & vbtab & _
"Install State" & vbtab & "Name" & vbtab & _
"Package Cache" & vbtab & "SKU Number" & vbtab & "Vendor" & vbtab _
& "Version"

For Each objSoftware in colSoftware
objTextFile.WriteLine objSoftware.Caption & vbtab & _
objSoftware.Description & vbtab & _
objSoftware.IdentifyingNumber & vbtab & _
objSoftware.InstallDate2 & vbtab & _
objSoftware.InstallLocation & vbtab & _
objSoftware.InstallState & vbtab & _
objSoftware.Name & vbtab & _
objSoftware.PackageCache & vbtab & _
objSoftware.SKUNumber & vbtab & _
objSoftware.Vendor & vbtab & _
objSoftware.Version
Next


' This searches for a string of txt in a file

Dim FoundTitle 'as boolean
Dim FoundVersion 'as boolean
FoundTitle=false 'initialize it to false
FoundVersion=false 'initialize it to false
With createobject("Scripting.FileSystemObject")
on error resume next
FoundTitle = (InStr(1,.OpenTextFile("C:\WINDOWS\Temp\software.tsv",1,true,-2).ReadAll, softwareTitle,1) <> 0)
FoundVersion = (InStr(1,.OpenTextFile("C:\WINDOWS\Temp\software.tsv",1,true,-2).ReadAll, softwareVersion,1) <> 0)
on error goto 0
End With

'wscript.echo FoundIt

' If Software title is found run script
Const wshYes = 6
Const wshNo = 7
Const wshYesNoDialog = 4
Const wshQuestionMark = 32
Const wshWarningMark = 48
Const wshInformationMark = 64
Const FOF_CREATEPROGRESSDLG = &H0&

Set objShell = WScript.CreateObject("Wscript.Shell")
' If Software title is found
If FoundTitle and FoundVersion Then
objShell.Popup softwareVersion & " is already installed. No further action is needed on your part. Thank you", _
-1, softwareTitle, wshInformationMark
Else
' Begin File Copy
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(strTargetFolder)
'---------------------------------------------------------------------------
If objFSO.fileExists(strTargetFolder + strInstallFile1) Then
Else
objFolder.CopyHere strSourceFolder + strInstallFile1, FOF_CREATEPROGRESSDLG 'Change the install file(s) location as needed.
End If
REM If objFSO.fileExists(strTargetFolder + strInstallFile2) Then 'Remove/Comment out if not used
REM Else
REM objFolder.CopyHere strSourceFolder + strInstallFile2, FOF_CREATEPROGRESSDLG
REM End If
REM If objFSO.fileExists(strTargetFolder + strInstallFile3) Then 'Remove/Comment out if not used
REM Else
REM objFolder.CopyHere strSourceFolder + strInstallFile3, FOF_CREATEPROGRESSDLG
REM End If
REM If objFSO.folderExists(strTargetFolder + strInstallFolder1) Then 'Remove/Comment out if not used
REM Else
REM objFolder.CopyHere strSourceFolder + strInstallFolder1, FOF_CREATEPROGRESSDLG
REM End If
'---------------------------------------------------------------------------
' Begin Install
intReturn = objShell.Popup("Do you want to begin the install of " & softwareTitle & " now?", _
-1, softwareTitle, wshYesNoDialog + wshQuestionMark)
If intReturn = wshYes Then
'---------------------------------------------------------------------------
objShell.Run(InstallScript), 0, True 'Change the install script location as needed.
'---------------------------------------------------------------------------
intReboot = objShell.Popup("Install Complete! Would you like to reboot now?", -1, "Reboot Required", wshYesNoDialog + wshQuestionMark)
If intReboot = wshYes Then
objShell.Run ("C:\WINDOWS\system32\shutdown.exe -r -t 0")
ElseIf intReboot = wshNo Then
Wscript.Echo "Please reboot as soon as possible."
Else intForcedReboot = objShell.Popup("Your computer will reboot now.", 10, "Warning", wshWarningMark)
objShell.Run ("C:\WINDOWS\system32\shutdown.exe -r -t 0")
End If
ElseIf intReturn = wshNo Then
Wscript.Echo "Please run the update process as soon as possible. You will not be able to utilize the many features of Lync until you do so."
Else
'---------------------------------------------------------------------------
objShell.Run(InstallScript), 0, True 'Change the install script location as needed.
'---------------------------------------------------------------------------
objShell.Popup softwareTitle & " is complete!", _
-1, "Install complete", wshInformationMark
End If

' End If for software Title = false and install
End If

objTextFile.Close

' Check the operating system
Function IsWindows7
Set OSSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" _
& "./root/cimv2").ExecQuery("select Caption from Win32_OperatingSystem")
For Each OS In OSSet
sOS = OS.Caption
Next
IsWindows7 = (InStr(1, sOS, "Windows 7", 1) + InStr(1, sOS, "Vista") > 0)
End Function

' Force a UAC challenge
Sub ElevateUAC
if not isWindows7 then Exit Sub
sParms = " |"
If WScript.Arguments.Count > 0 Then
For i = WScript.Arguments.Count-1 To 0 Step -1
sParms = " " & WScript.Arguments(i) & sParms
Next
End If
Set oShell = CreateObject("Shell.Application")
oShell.ShellExecute "wscript.exe", WScript.ScriptFullName & sParms, , "runas", 1
WScript.Quit
End Sub


Comments

  • I look forward to trying this out I have ths same problem with trying to install software for users on win7 - shigbee 12 years ago
  • Thanks! would be testing this out. - adilrathore 12 years ago
This post is locked

Don't be a Stranger!

Sign up today to participate, stay informed, earn points and establish a reputation for yourself!

Sign up! or login

Share

 
This website uses cookies. By continuing to use this site and/or clicking the "Accept" button you are providing consent Quest Software and its affiliates do NOT sell the Personal Data you provide to us either when you register on our websites or when you do business with us. For more information about our Privacy Policy and our data protection efforts, please visit GDPR-HQ