Sample script that makes use of subinacl to modfiy permissions for files and/or registry, in this case I have done a function for alter file permissions, when I have to do somehthing for the registry I will add a new function or modify this one (you will need to obtain a copy of subinacl.exe from Microsoft which I believe is free):
Sub SetPermissions(strTarget, strUser, strAccess)
'On Error Resume Next
Dim wshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
wshShell.Run "subinacl.exe /subdirectories=directoriesonly " & """" & strTarget & """" & " /grant=" & """" & strUser & """" & "=" & strAccess, 0, True
wshShell.Run "subinacl.exe /subdirectories=directoriesonly " & """" & strTarget & "\*.*" & """" & " /grant=" & """" & strUser & """" & "=" & strAccess, 0, True
wshShell.Run "subinacl.exe /subdirectories=filesonly " & """" & strTarget & "\*.*" & """" & " /grant=" & """" & StrUser & """" & "=" & strAccess, 0, True
End Sub
'Ignore the following lines more as reference to myself for when I get around to doing it for registry keys
wshShell.Run "subinacl.exe /keyreg " & """" & "HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Bloomberg L.P." & """" & " /grant=" & """" & "Authenticated Users" & """" & "=" & "F", 0, True
wshShell.Run "subinacl.exe /keyreg " & """" & "HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Bloomberg L.P." & """" & " /grant=" & """" & "Authenticated Users" & """" & "=" & "F", 0, True
Wednesday, 14 November 2012
Clear IE Cache FYI
Was looking for a way of clearing out IE cache as a prerequisite to the installation to a piece of software, ended up not needing to do this, but I am sure I will need this again at some stage, should be easy enough to just execute this through a script.
Found here:
Found here:
Appears to work on IE9.
Temporary Internet Files
RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8
Cookies
RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 2
History
RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 1
Form Data
RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 16
Passwords
RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 32
Delete All
RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 255
Delete All – “Also delete files and settings stored by add-ons”
RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 4351
These commands should work in Internet Explorer 7 on XP or on Windows Vista.
Wednesday, 17 October 2012
Install MSI, MST & MSP all at once
Reason for this post is that if you attempt to use the PATCH property it requires that you provide the full path to the patch, there are other methods for obtaining this which is at the bottom of this post. If you are wondering about the strLog I got a little bored, I am sure there is a more efficient way of creating the log file name.
On Error Resume Next
Dim wshShell, strMSI, strTransform, strPatch, objFSO, strLogPath
Set wshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strMSI = "YourMSI.msi"
strTransform = "YourMST.mst"
strPatch = objFSO.GetAbsolutePathName("") & "\" & "YourPatch.msp"
strLog = wshShell.ExpandEnvironmentStrings("%windir%") & "\MSILogs\" & Left(strMSI, InStr(strMSI,".msi")) & "log"
wshShell.Run "msiexec /i " & """" & strMSI & """" & " TRANSFORMS=" & """" & strTransform & """" & " PATCH=" & """" & strPatch & """" & " /qb! /norestart /l*v " & strLog, 0, True
Set wshShell = Nothing
Set objFSO = Nothing
If err.Number = 0 Then
wScript.Quit 0
Else
wScript.Quit err.Number
End If
Obtained from:
http://www.visualbasicscript.com/how-to-get-working-drive-and-directory-m1248.aspx
Set fso = CreateObject("Scripting.FileSystemObject")
GetAbsolutePath = fso.GetAbsolutePathName("Wscript.ScriptName") 'Returns path and file name of file specified
GetTheParent = fso.GetParentFolderName("Wscript.ScriptName")'Returns the parentfolder of the Path/File specified
GetTheBase = fso.GetBaseName("Wscript.ScriptName")'Returns the file name minus file extension
GetTheScriptFullName = WScript.ScriptFullName'Returns path of the script being called.
GetTheScriptName = Wscript.ScriptName'Returns the name of the script
msgbox "Using AbsolutePath: " & GetAbsolutePath & vbcr _
& "Using GetParentFolderName: " & GetTheParent & vbcr _
& "Using GetBaseName: " & GetTheBase & vbcr _
& "Using ScriptFullName: " & GetTheScriptFullName & vbcr _
& "Using ScriptName: " & GetTheScriptName
Or if you use batch files:
Echo %~f0
http://stackoverflow.com/questions/1421286/getting-a-batch-files-full-path
On Error Resume Next
Dim wshShell, strMSI, strTransform, strPatch, objFSO, strLogPath
Set wshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strMSI = "YourMSI.msi"
strTransform = "YourMST.mst"
strPatch = objFSO.GetAbsolutePathName("") & "\" & "YourPatch.msp"
strLog = wshShell.ExpandEnvironmentStrings("%windir%") & "\MSILogs\" & Left(strMSI, InStr(strMSI,".msi")) & "log"
wshShell.Run "msiexec /i " & """" & strMSI & """" & " TRANSFORMS=" & """" & strTransform & """" & " PATCH=" & """" & strPatch & """" & " /qb! /norestart /l*v " & strLog, 0, True
Set wshShell = Nothing
Set objFSO = Nothing
If err.Number = 0 Then
wScript.Quit 0
Else
wScript.Quit err.Number
End If
Obtained from:
http://www.visualbasicscript.com/how-to-get-working-drive-and-directory-m1248.aspx
Set fso = CreateObject("Scripting.FileSystemObject")
GetAbsolutePath = fso.GetAbsolutePathName("Wscript.ScriptName") 'Returns path and file name of file specified
GetTheParent = fso.GetParentFolderName("Wscript.ScriptName")'Returns the parentfolder of the Path/File specified
GetTheBase = fso.GetBaseName("Wscript.ScriptName")'Returns the file name minus file extension
GetTheScriptFullName = WScript.ScriptFullName'Returns path of the script being called.
GetTheScriptName = Wscript.ScriptName'Returns the name of the script
msgbox "Using AbsolutePath: " & GetAbsolutePath & vbcr _
& "Using GetParentFolderName: " & GetTheParent & vbcr _
& "Using GetBaseName: " & GetTheBase & vbcr _
& "Using ScriptFullName: " & GetTheScriptFullName & vbcr _
& "Using ScriptName: " & GetTheScriptName
Or if you use batch files:
Echo %~f0
http://stackoverflow.com/questions/1421286/getting-a-batch-files-full-path
Monday, 15 October 2012
Microsoft Hotfix/KB Check
Created the below for a requirement installed check in CM 2012, based on the script here:
http://desktopdeploy.wordpress.com/2010/04/26/vbscript-list-ms-hotfixes-installed/
Option Explicit
On Error Resume Next
Dim strComputer, objWMIService, colQuickFixes, objQuickFix, HFInstalled, HFID
strComputer = "."
HFID = "KB958830"
HFInstalled = False
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colQuickFixes = objWMIService.ExecQuery ("Select * from Win32_QuickFixEngineering")
For Each objQuickFix in colQuickFixes
If objQuickFix.HotFixID = HFID Then
HFInstalled = True
Exit For
End If
Next
If HFInstalled = True Then
wScript.Quit 0
Else
wScript.Quit 1
End If
http://desktopdeploy.wordpress.com/2010/04/26/vbscript-list-ms-hotfixes-installed/
Option Explicit
On Error Resume Next
Dim strComputer, objWMIService, colQuickFixes, objQuickFix, HFInstalled, HFID
strComputer = "."
HFID = "KB958830"
HFInstalled = False
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colQuickFixes = objWMIService.ExecQuery ("Select * from Win32_QuickFixEngineering")
For Each objQuickFix in colQuickFixes
If objQuickFix.HotFixID = HFID Then
HFInstalled = True
Exit For
End If
Next
If HFInstalled = True Then
wScript.Quit 0
Else
wScript.Quit 1
End If
Sunday, 16 September 2012
Scripts and exit codes
Colleague of mine asked me to write a small blurb on using exit codes when using scripts to wrap packages for deployment. This is a very simplistic overview. This is from an SMS/SCCM perspective, though this probably applies to other deployment tools (maybe).
Typically if you are just using some sort of script execute say an msi it might be in the following format:
On Error Resume Next
objFSO.dosomestuff
wshShell.Run "SomeApplication.msi" /qb /norestart
wScript.quit
This for the most part is fine, as long as you do not run into any problems with the deployment. The above will effectively always exit with a success code, so when you are looking through the deployment reports from SCCM even if the application failed to install on all of the machines you are going to get 100% success rate as the script it self completed successfully.
A very basic way around this would be to have something like this:
If err.number <> 0 Then
wScript.quit 1
Else
wScript.quit 0
End If
Where 1 is a generic error code and 0 is a generic success code. So if there is an issue with the execution of that msi then you will at least get an idea that there is a problem.
SCCM has a few exit codes that you could use in order to manipulate the advertisement behaviour:
Typically if you are just using some sort of script execute say an msi it might be in the following format:
On Error Resume Next
objFSO.dosomestuff
wshShell.Run "SomeApplication.msi" /qb /norestart
wScript.quit
This for the most part is fine, as long as you do not run into any problems with the deployment. The above will effectively always exit with a success code, so when you are looking through the deployment reports from SCCM even if the application failed to install on all of the machines you are going to get 100% success rate as the script it self completed successfully.
A very basic way around this would be to have something like this:
If err.number <> 0 Then
wScript.quit 1
Else
wScript.quit 0
End If
Where 1 is a generic error code and 0 is a generic success code. So if there is an issue with the execution of that msi then you will at least get an idea that there is a problem.
SCCM has a few exit codes that you could use in order to manipulate the advertisement behaviour:
Success:
0
0
Reboot:
1604
1641
3010
3011
1604
1641
3010
3011
Retry*:
4
5
8
13
14
39
51
53
54
55
59
64
65
67
70
71
85
86
87
112
128
170
267
999
1003
1203
1219
1220
1222
1231
1232
1238
1265
1311
1323
1326
1330
1618
1622
2250
4
5
8
13
14
39
51
53
54
55
59
64
65
67
70
71
85
86
87
112
128
170
267
999
1003
1203
1219
1220
1222
1231
1232
1238
1265
1311
1323
1326
1330
1618
1622
2250
*) A retry exit code will force SMS/SCCM to rerun the advertisement after a timeout of 10 minutes.
The above exit codes are from here:
Thursday, 13 September 2012
Ping script (VBS)
Will ping list of machines and write results to log file, will also attempt to move old log files to an archive folder. You need to create a text file called "hosts.txt" and paste in the machine names that you wish to ping.
Option Explicit
'On Error Resume Next
Dim objFSO, objFile, Hostname, varHostsFileName, varLogFileName, varArchFld
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
varHostsFileName = "Hosts.txt"
varLogFileName = "Ping" & Hour(Time) & Minute(Time) & Second(Time)
varArchFld = "Archive\" & Year(Date) & Month(Date) & Day(Date)
Archive
Set objFile = objFSO.OpenTextFile(varHostsFileName, ForReading)
Do Until objFile.AtEndOfStream
HostName = objFile.ReadLine()
If Ping(HostName) = "Online" Then
LogFile Hostname & vbTab & "Online", varLogFileName
Else
LogFile Hostname & vbTab & "Offline", varLogFileName
End If
Loop
objFile.Close
wScript.Quit
'Subs & Functions
Function Ping(HostName)
'On Error Resume Next
Dim colPingResults, objPingResult, strQuery
strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & HostName & "'"
Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
For Each objPingResult In colPingResults
If Not IsObject(objPingResult) Then
Ping = "Offline"
ElseIf objPingResult.StatusCode = 0 Then
Ping = "Online"
Else
Ping = "Offline"
End If
Next
Set colPingResults = Nothing
End Function
Sub LogFile(strInput, varLogFileName)
'On Error Resume Next
Dim objFSO, LogFile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set LogFile = objFSO.OpenTextFile(varLogFileName & ".log", ForAppending, True)
LogFile.WriteLine(FormatDateTime(Date, 2) & vbTab & FormatDateTime(Time, 4) & ":" & Second(Time) & vbTab & strInput)
LogFile.Close
End Sub
Sub CreateFld(Fld)
'On Error Resume Next
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Fld <> "" Then
If Not objFSO.FolderExists(objFSO.GetParentFolderName(Fld)) Then
Call CreateFld(objFSO.GetParentFolderName(Fld))
End If
objFSO.CreateFolder(Fld) & "\"
End If
End Sub
Sub Archive
On Error Resume Next
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
CreateFld(varArchFld)
objFSO.MoveFile "*.log", varArchFld & "\"
End Sub
Functions & Sub Routines
'Create target folder and all subfolders if they do not exist.
Sub CreateFld(Fld)
'On Error Resume Next
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Fld <> "" Then
If Not objFSO.FolderExists(objFSO.GetParentFolderName(Fld)) Then
Call CreateFld(objFSO.GetParentFolderName(Fld))
End If
If Not objFSO.FolderExists(Fld) Then
objFSO.CreateFolder(Fld) & "\"
End If
End If
End Sub
'Ping machine returns value of "Offline" or "Online"
Function Ping(HostName)
'On Error Resume Next
Dim colPingResults, objPingResult, strQuery
strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & HostName & "'"
Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
For Each objPingResult In colPingResults
If Not IsObject(objPingResult) Then
Ping = "Offline"
ElseIf objPingResult.StatusCode = 0 Then
Ping = "Online"
Else
Ping = "Offline"
End If
Next
Set colPingResults = Nothing
End Function
'Creates log and writes to log given input and log name
Sub LogFile(strInput, varLogFileName)
'On Error Resume Next
Dim objFSO, LogFile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set LogFile = objFSO.OpenTextFile(varLogFileName & ".log", ForAppending, True)
LogFile.WriteLine(FormatDateTime(Date, 2) & vbTab & FormatDateTime(Time, 4) & ":" & Second(Time) & vbTab & strInput)
LogFile.Close
End Sub
'Captures the output of a dos command and returns it in a string found here:
http://www.visualbasicscript.com/tm.aspx?high=&m=42892&mpage=1#42892
wscript.echo fShellRun("%comspec% /c dir c:\")
Function fShellRun(sCommandStringToExecute)
' This function will accept a string as a DOS command to execute.
' It will then execute the command in a shell, and capture the output into a file.
' That file is then read in and its contents are returned as the value the function returns.
Dim oShellObject, oFileSystemObject, sShellRndTmpFile
Dim oShellOutputFileToRead, iErr
Set oShellObject = CreateObject("Wscript.Shell")
Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
sShellRndTmpFile = oShellObject.ExpandEnvironmentStrings("%temp%") & oFileSystemObject.GetTempName
On Error Resume Next
oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 0, True
iErr = Err.Number
On Error GoTo 0
If iErr <> 0 Then
fShellRun = ""
Exit Function
End If
fShellRun = oFileSystemObject.OpenTextFile(sShellRndTmpFile,1).ReadAll
oFileSystemObject.DeleteFile sShellRndTmpFile, True
End Function
'Returns chassis type, useful for identifying notebooks and workstations slightly tweaked from here:
http://blogs.technet.com/b/heyscriptingguy/archive/2004/09/21/how-can-i-determine-if-a-computer-is-a-laptop-or-a-desktop-machine.aspx
Function Chassis
'On Error Resume Next
Dim strComputer, objWMIService, colChassis, objChassis
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colChassis = objWMIService.ExecQuery ("Select * from Win32_SystemEnclosure")
For Each objChassis in colChassis
For Each strChassisType in objChassis.ChassisTypes
Select Case strChassisType
Case 1
Chassis = "Other"
Case 2
Chassis = "Unknown"
Case 3
Chassis = "Desktop"
Case 4
Chassis = "Low Profile Desktop"
Case 5
Chassis = "Pizza Box"
Case 6
Chassis = "Mini Tower"
Case 7
Chassis = "Tower"
Case 8
Chassis = "Portable"
Case 9
Chassis = "Laptop"
Case 10
Chassis = "Notebook"
Case 11
Chassis = "Handheld"
Case 12
Chassis = "Docking Station"
Case 13
Chassis = "All-in-One"
Case 14
Chassis = "Sub-Notebook"
Case 15
Chassis = "Space Saving"
Case 16
Chassis = "Lunch Box"
Case 17
Chassis = "Main System Chassis"
Case 18
Chassis = "Expansion Chassis"
Case 19
Chassis = "Sub-Chassis"
Case 20
Chassis = "Bus Expansion Chassis"
Case 21
Chassis = "Peripheral Chassis"
Case 22
Chassis = "Storage Chassis"
Case 23
Chassis = "Rack Mount Chassis"
Case 24
Chassis = "Sealed-Case PC"
Case Else
Chassis = "Unknown"
End Select
Next
Next
End Function
'Check for existence of reg value and returns value of true or false
Function RegValueExist(strRegHive, strKeyPath, strValueName)
On Error Resume Next
Dim strComputer, objRegistry, strValue
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
Select Case strRegHive
Case "HKCR"
objRegistry.GetStringValue HKEY_CLASSES_ROOT, strKeyPath,strValueName,strValue
Case "HKCU"
objRegistry.GetStringValue HKEY_CURRENT_USER, strKeyPath,strValueName,strValue
Case "HKLM"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath,strValueName,strValue
Case "HKU"
objRegistry.GetStringValue HKEY_USERS, strKeyPath,strValueName,strValue
Case "HKCC"
objRegistry.GetStringValue HKEY_CURRENT_CONFIG, strKeyPath,strValueName,strValue
End Select
If IsNull(strValue) Then
RegValueExist = False
Else
RegValueExist = True
End If
End Function
Usage:
RegValueExist ("RegHive", "Software\Test", "RegValueName")
'Check for existence of reg key and returns value of true or false
Function RegKeyExists(strHive, strKeyPath)
On Error Resume Next
Dim strComputer, objRegistry, arrSubKeys
Const HKCR = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Const HKUS = &H80000003 'HKEY_USERS
Const HKCC = &H80000005 'HKEY_CURRENT_CONFIG
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
RegKeyExists = False
Select Case strHive
Case "HKCR"
If objRegistry.EnumKey (HKCR, strKeyPath) = 0 Then
RegKeyExists = True
End If
Case "HKCU"
If objRegistry.EnumKey (HKCU, strKeyPath) = 0 Then
RegKeyExists = True
End If
Case "HKLM"
If objRegistry.EnumKey (HKLM, strKeyPath) = 0 Then
RegKeyExists = True
End If
Case "HKU"
If objRegistry.EnumKey (HKU, strKeyPath) = 0 Then
RegKeyExists = True
End If
Case "HKCC"
If objRegistry.EnumKey (HKCC, strKeyPath) = 0 Then
RegKeyExists = True
End If
End Select
End Function
Usage:
RegKeyExists("RegHive","RegKeyPath")
'Created this for a package that included a licence key that I was unable to create a response file for. Sometimes you have windows that only appear if certain conditions are met, so to account for this i have included a case statement to allow for this
Function ActiveWindow(strWindow, intWaitTime)
On Error Resume Next
Dim wshShell, intFailSafe
intFailSafe = 0
Set wshShell = WScript.CreateObject("WScript.Shell")
Select Case strWindow
Case "Your application window name"
Do Until wshShell.AppActivate(strWindow) = True Or intFailSafe > intWaitTime
wScript.Sleep 5000
intFailSafe = intFailSafe + 1
Loop
If wshShell.AppActivate(strWindow) = True Then
wshShell.SendKeys "%(y)"
Exit Function
End If
Exit Function
Case Else
Do Until wshShell.AppActivate(strWindow) = True Or intFailSafe > intWaitTime
wScript.Sleep 5000
intFailSafe = intFailSafe + 1
Loop
If intFailSafe > intWaitTime Then
wscript.quit 1
End If
End Select
End Function
Usage:
strWindow = "Your application window name"
inWaitTime = "Total time you want it to wait for this window before moving on, it is currently in increments of 5 seconds so if you set 12 it will wait for 1 minute"
ActiveWindow(strWindow, intWaitTime)
Sub CreateFld(Fld)
'On Error Resume Next
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Fld <> "" Then
If Not objFSO.FolderExists(objFSO.GetParentFolderName(Fld)) Then
Call CreateFld(objFSO.GetParentFolderName(Fld))
End If
If Not objFSO.FolderExists(Fld) Then
objFSO.CreateFolder(Fld) & "\"
End If
End If
End Sub
'Ping machine returns value of "Offline" or "Online"
Function Ping(HostName)
'On Error Resume Next
Dim colPingResults, objPingResult, strQuery
strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & HostName & "'"
Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
For Each objPingResult In colPingResults
If Not IsObject(objPingResult) Then
Ping = "Offline"
ElseIf objPingResult.StatusCode = 0 Then
Ping = "Online"
Else
Ping = "Offline"
End If
Next
Set colPingResults = Nothing
End Function
'Creates log and writes to log given input and log name
Sub LogFile(strInput, varLogFileName)
'On Error Resume Next
Dim objFSO, LogFile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set LogFile = objFSO.OpenTextFile(varLogFileName & ".log", ForAppending, True)
LogFile.WriteLine(FormatDateTime(Date, 2) & vbTab & FormatDateTime(Time, 4) & ":" & Second(Time) & vbTab & strInput)
LogFile.Close
End Sub
'Captures the output of a dos command and returns it in a string found here:
http://www.visualbasicscript.com/tm.aspx?high=&m=42892&mpage=1#42892
wscript.echo fShellRun("%comspec% /c dir c:\")
Function fShellRun(sCommandStringToExecute)
' This function will accept a string as a DOS command to execute.
' It will then execute the command in a shell, and capture the output into a file.
' That file is then read in and its contents are returned as the value the function returns.
Dim oShellObject, oFileSystemObject, sShellRndTmpFile
Dim oShellOutputFileToRead, iErr
Set oShellObject = CreateObject("Wscript.Shell")
Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
sShellRndTmpFile = oShellObject.ExpandEnvironmentStrings("%temp%") & oFileSystemObject.GetTempName
On Error Resume Next
oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 0, True
iErr = Err.Number
On Error GoTo 0
If iErr <> 0 Then
fShellRun = ""
Exit Function
End If
fShellRun = oFileSystemObject.OpenTextFile(sShellRndTmpFile,1).ReadAll
oFileSystemObject.DeleteFile sShellRndTmpFile, True
End Function
'Returns chassis type, useful for identifying notebooks and workstations slightly tweaked from here:
http://blogs.technet.com/b/heyscriptingguy/archive/2004/09/21/how-can-i-determine-if-a-computer-is-a-laptop-or-a-desktop-machine.aspx
Function Chassis
'On Error Resume Next
Dim strComputer, objWMIService, colChassis, objChassis
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colChassis = objWMIService.ExecQuery ("Select * from Win32_SystemEnclosure")
For Each objChassis in colChassis
For Each strChassisType in objChassis.ChassisTypes
Select Case strChassisType
Case 1
Chassis = "Other"
Case 2
Chassis = "Unknown"
Case 3
Chassis = "Desktop"
Case 4
Chassis = "Low Profile Desktop"
Case 5
Chassis = "Pizza Box"
Case 6
Chassis = "Mini Tower"
Case 7
Chassis = "Tower"
Case 8
Chassis = "Portable"
Case 9
Chassis = "Laptop"
Case 10
Chassis = "Notebook"
Case 11
Chassis = "Handheld"
Case 12
Chassis = "Docking Station"
Case 13
Chassis = "All-in-One"
Case 14
Chassis = "Sub-Notebook"
Case 15
Chassis = "Space Saving"
Case 16
Chassis = "Lunch Box"
Case 17
Chassis = "Main System Chassis"
Case 18
Chassis = "Expansion Chassis"
Case 19
Chassis = "Sub-Chassis"
Case 20
Chassis = "Bus Expansion Chassis"
Case 21
Chassis = "Peripheral Chassis"
Case 22
Chassis = "Storage Chassis"
Case 23
Chassis = "Rack Mount Chassis"
Case 24
Chassis = "Sealed-Case PC"
Case Else
Chassis = "Unknown"
End Select
Next
Next
End Function
'Check for existence of reg value and returns value of true or false
Function RegValueExist(strRegHive, strKeyPath, strValueName)
On Error Resume Next
Dim strComputer, objRegistry, strValue
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
Select Case strRegHive
Case "HKCR"
objRegistry.GetStringValue HKEY_CLASSES_ROOT, strKeyPath,strValueName,strValue
Case "HKCU"
objRegistry.GetStringValue HKEY_CURRENT_USER, strKeyPath,strValueName,strValue
Case "HKLM"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath,strValueName,strValue
Case "HKU"
objRegistry.GetStringValue HKEY_USERS, strKeyPath,strValueName,strValue
Case "HKCC"
objRegistry.GetStringValue HKEY_CURRENT_CONFIG, strKeyPath,strValueName,strValue
End Select
If IsNull(strValue) Then
RegValueExist = False
Else
RegValueExist = True
End If
End Function
Usage:
RegValueExist ("RegHive", "Software\Test", "RegValueName")
'Check for existence of reg key and returns value of true or false
Function RegKeyExists(strHive, strKeyPath)
On Error Resume Next
Dim strComputer, objRegistry, arrSubKeys
Const HKCR = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Const HKUS = &H80000003 'HKEY_USERS
Const HKCC = &H80000005 'HKEY_CURRENT_CONFIG
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
RegKeyExists = False
Select Case strHive
Case "HKCR"
If objRegistry.EnumKey (HKCR, strKeyPath) = 0 Then
RegKeyExists = True
End If
Case "HKCU"
If objRegistry.EnumKey (HKCU, strKeyPath) = 0 Then
RegKeyExists = True
End If
Case "HKLM"
If objRegistry.EnumKey (HKLM, strKeyPath) = 0 Then
RegKeyExists = True
End If
Case "HKU"
If objRegistry.EnumKey (HKU, strKeyPath) = 0 Then
RegKeyExists = True
End If
Case "HKCC"
If objRegistry.EnumKey (HKCC, strKeyPath) = 0 Then
RegKeyExists = True
End If
End Select
End Function
Usage:
RegKeyExists("RegHive","RegKeyPath")
'Created this for a package that included a licence key that I was unable to create a response file for. Sometimes you have windows that only appear if certain conditions are met, so to account for this i have included a case statement to allow for this
Function ActiveWindow(strWindow, intWaitTime)
On Error Resume Next
Dim wshShell, intFailSafe
intFailSafe = 0
Set wshShell = WScript.CreateObject("WScript.Shell")
Select Case strWindow
Case "Your application window name"
Do Until wshShell.AppActivate(strWindow) = True Or intFailSafe > intWaitTime
wScript.Sleep 5000
intFailSafe = intFailSafe + 1
Loop
If wshShell.AppActivate(strWindow) = True Then
wshShell.SendKeys "%(y)"
Exit Function
End If
Exit Function
Case Else
Do Until wshShell.AppActivate(strWindow) = True Or intFailSafe > intWaitTime
wScript.Sleep 5000
intFailSafe = intFailSafe + 1
Loop
If intFailSafe > intWaitTime Then
wscript.quit 1
End If
End Select
End Function
Usage:
strWindow = "Your application window name"
inWaitTime = "Total time you want it to wait for this window before moving on, it is currently in increments of 5 seconds so if you set 12 it will wait for 1 minute"
ActiveWindow(strWindow, intWaitTime)
Subscribe to:
Posts (Atom)