Disclaimer

Wednesday 14 November 2012

File & registry permissions with subinacl

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

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:
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




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

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:

Success:
Reboot:
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
*) 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)