'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)
