VBS

Time sync during OS Deployment

After Microsoft Surface arrived in our production environment we have been challenged by time sync issues during OS deployment. The Surface devices were so much off in date and time that they were rejected by the management point resulting in a failed Task Sequence.

Instead of powering up the Surface and adjusting the time manually i wanted to automate this during deployment. I found out that Niall Brady have made a timesync script that can sync the time on the client with a server using NET TIME.

Adding this script to the prestart command on the Boot image will then sync the time with the server specified prior to running the task sequence and voila – problem solved.

' (c) niall@windows-noob.com 2014/7/24
' This script allows you to sync the time in WinPE with a local server using a prestart command
' Fill in the user/password/domain/server details below
' For more guides see http://www.windows-noob.com/forums/index.php?/topic/4045-system-center-2012-configuration-manager-guides/ 
' for troubleshooting, review the log files created
' net use (to see all existing connections)
' net use * /del /yes (to delete all existing connections) 

Option Explicit
DIM ComSpec, WshShell, strUser, strPassword, strDomain, strServer, strCommand, LogFileName, logfile, objFSO, objFile, outFile

Set WshShell = CREATEOBJECT("WScript.Shell")
strUser = "SCCM_DJ"
strPassword = "DJpassw0rd"
strDomain = "domain.com"
strServer = "server"

PrepLogFile
Logtext "Starting logging process."
LogText "sleeping for 15 seconds.."
WScript.Sleep 5000
LogText "Using NET USE to Connect to " & strServer & " as a Domain user.."
strCommand = ComSpec & ("cmd /c net use \\") & strServer & ("\ipc$") & (" ") & strPassword & (" ") & ("/user:") & strDomain & ("\") & strUser & (" ") & (">") & (" ") & ("x:\WinPE_net_use.log")

		If WshShell.Run (strCommand, 0, True) = 0 then
			LogText "...NET USE connected ok, continuing."
			'On Error GoTo 0
		else
			LogText "...NET USE had an error."
			ExitScript -1
		end if

LogText "Using the NET TIME command to sync with the Server time.."
strCommand = ("cmd /c net time \\") & strServer & (" /SET /Y") & (">") & (" ") & ("x:\WinPE_net_time.log")
WshShell.Run strCommand

'wait for 5 seconds so the new time is registered before talking to the mp
LogText "Waiting for 5 seconds so the new time is registered before talking to the mp.."

LogText "all done, exiting.." 

' =====================================================
' PrepLogFile Subroutine
' =====================================================

Sub PrepLogFile
	
	Dim objFSO

	Set wShShell = WScript.CreateObject("WScript.Shell")
	LogFileName = "X:\WinPE_TimeSync.log"
	'LogFileName = "c:\tmp\WinPE_TimeSync.log"

	'On Error Resume Next
	Err.Clear

	Set objFSO = CreateObject("Scripting.FileSystemObject")
	
	If Err.number <> 0 Then
		MsgBox("****   ERROR (" & Err.Number & ") Could not create Logfile - exiting script")
		ExitScript 0
	Else
		If objFSO.FileExists(LogFileName) Then
			objFSO.DeleteFile(LogFileName) 
		End If
		Err.Clear
		Set logfile = objFSO.CreateTextFile(LogFileName)
		If Err.number <> 0 Then
			MsgBox "ERROR (" & Err.Number & ") Could not create logfile (File) - exiting script"
			ExitScript 0
		End If
	End If
	
	Err.Clear
	
'On Error GoTo 0
	
	logfile.writeline "##############################################"
	logfile.writeline "    windows-noob.com WinPE Time sync Script   "
	logfile.writeline "##############################################"
End Sub

' =====================================================
' LogText Subroutine
' =====================================================

Sub LogText (TextToLog)
	logfile.writeline "" & Now() & " " & TextToLog
End Sub

' =====================================================
' Exit function
' =====================================================

Function ExitScript(iStatus)
	if iStatus <> 0 then
		set WshShell = WScript.CreateObject("WScript.Shell")
		ComSpec = WshShell.ExpandEnvironmentStrings("%COMSPEC%")
		WshShell.Run "cmtrace.exe " & LogFileName , 1, False
	End if

	LogText "All done, exiting successfully"
	wscript.quit(iStatus)
End Function

Extract Drivers

This script will extract all drivers from a computer and copy them to a folder structure organized by type. It is language dependent and currently works for Danish and English Operating System language.

Option Explicit

Dim WshShell, oExec
Set WshShell = CreateObject("WScript.Shell")

Set oExec = WshShell.Exec("Dism.exe /online /get-drivers")

WScript.Echo "Started, Get drivers"

Dim iCounter
iCounter = 0
Do While oExec.Status = 0 And iCounter < 600
	WScript.Sleep 100
	iCounter = iCounter + 1
Loop

WScript.Echo "Execute time: " & iCounter / 10 & " Sec."
WScript.Echo "Exit Code: " & oExec.ExitCode

Dim sText, sDriverList
Dim aDriverList()
Dim iDriversCount
iDriversCount = 0
Do While Not oExec.StdOut.AtEndOfStream
	sText = oExec.StdOut.ReadLine()
	If Left(sText,17) = "Published Name : " Or Left(sText,17) = "Udgivelsesnavn : " Then
		ReDim Preserve aDriverList(iDriversCount)
		aDriverList(iDriversCount) = Trim(Right(sText,Len(sText)-17))
		iDriversCount = iDriversCount + 1
	End If
Loop

Dim sElement
Dim aOEMDriverPaths(), aOEMDriverClasses(), aOEMDriverVersion()

WScript.Echo "Number of OEM Drivers: " & iDriversCount

iDriversCount = 0
For Each sElement In aDriverList
	
	Set oExec = WshShell.Exec("Dism.exe /online /get-driverInfo:" & sElement)

	WScript.Echo "Started, get info for driver: " & sElement

	iCounter = 0
	Do While oExec.Status = 0 And iCounter < 100
		WScript.Sleep 100
		iCounter = iCounter + 1
	Loop

	WScript.Echo "Execute time: " & iCounter / 10 & " Sec."
	WScript.Echo "Exit Code: " & oExec.ExitCode

	Do While Not oExec.StdOut.AtEndOfStream
		sText = oExec.StdOut.ReadLine()
		If Left(sText,20) = "Driver Store Path : " Then
			ReDim Preserve aOEMDriverPaths(iDriversCount)
			aOEMDriverPaths(iDriversCount) = Trim(Right(sText,Len(sText)-20))
		End If
		If Left(sText,22) = "Sti til driverlager : " Then
			ReDim Preserve aOEMDriverPaths(iDriversCount)
			aOEMDriverPaths(iDriversCount) = Trim(Right(sText,Len(sText)-22))
		End If
						    
		If Left(sText,13) = "Class Name : " Or Left(sText,13) = "Klassenavn : "Then
			ReDim Preserve aOEMDriverClasses(iDriversCount)
			aOEMDriverClasses(iDriversCount) = Trim(Right(sText,Len(sText)-13))
		End If
		If Left(sText,10) = "Version : " Then
			ReDim Preserve aOEMDriverVersion(iDriversCount)
			aOEMDriverVersion(iDriversCount) = Trim(Right(sText,Len(sText)-10))
			iDriversCount = iDriversCount + 1
		End If
	Loop
Next

Dim sScriptPath, sDriversDestinationPath
sScriptPath = Left(wscript.scriptfullname, Len(wscript.scriptfullname) - Len(wscript.scriptname))

Wscript.echo sScriptPath

Dim sComputer, oWMIService, cItems, oItem, sManufacturer, sModel
sComputer = "." 
Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\CIMV2") 
Set cItems = oWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem",,48) 
For Each oItem in cItems
    sManufacturer = oItem.Manufacturer
    sModel = oItem.Model
Next

WScript.Echo "Number of OEM Drivers: " & iDriversCount

Dim sInfFileName, sDriverVersion, sDriverCopySource, sDriverCopyDistination, iWaitCounter


For iCounter = 0 To iDriversCount-1

	sInfFileName = Right(aOEMDriverPaths(iCounter),Len(aOEMDriverPaths(iCounter))-InstrRev(aOEMDriverPaths(iCounter),"\",-1,vbTextCompare))
	sInfFileName = Left(sInfFileName,Len(sInfFileName)-4)
	sDriverVersion = aOEMDriverVersion(iCounter)
	sDriversDestinationPath = sScriptPath & "Drivers\" & sManufacturer & "\" & sModel & "\"
	sDriverCopySource = Left(aOEMDriverPaths(iCounter),InstrRev(aOEMDriverPaths(iCounter),"\",-1,vbTextCompare))
	sDriverCopyDistination = sDriversDestinationPath & aOEMDriverClasses(iCounter) & "\" & sInfFileName & "_" & sDriverVersion

	WScript.echo "Copy Driver: " & aOEMDriverClasses(iCounter) & " " & sInfFileName & " " & sDriverVersion

	CopyFolder sDriverCopySource, sDriverCopyDistination, "Precompiled Setup Information"
Next

Function CopyFolder(sSourceFolder, sDestinationFolder, sExcludeType)
	SearchSubFolders sSourceFolder, sDestinationFolder, sExcludeType
End Function

Sub SearchSubFolders(sSourceFoldersPath, sDestFoldersPath, sExcludeType)

	Dim oFileSystem, oFolder, oFile, aExcludeType, bExclude, sElement
	Set oFileSystem = CreateObject("Scripting.FileSystemObject")
	aExcludeType = Split(sExcludeType,",",-1,vbTextCompare)

	'** Søg i under mapper ************************************************************
	Set oFolder = oFileSystem.getFolder(sSourceFoldersPath)
	For Each ofile in oFolder.SubFolders
		SearchSubFolders sSourceFoldersPath & "\" & oFile.name, sDestFoldersPath & "\" & oFile.name, sExcludeType
	Next

	'** Kopier filer i mappe **********************************************************
	For Each oFile in oFolder.Files

		bExclude = False
		For Each sElement In aExcludeType
			If UCase(oFile.Type) = UCase(sElement) Then
				bExclude = True
			End If
		Next
		If Not bExclude Then
			CopyFile sSourceFoldersPath, sDestFoldersPath, oFile.name
		End If
	Next
	Set oFolder = Nothing
	Set oFileSystem = nothing

End Sub


Function CopyFile(sSourceFilePath, sDestFilePath, sFile)

	Dim oFileSystem, oCopyFile, oCopyFileDest, iSecondsDateDiff
	Set oFileSystem = CreateObject("Scripting.FileSystemObject")

	'** Kontroller om destinations filen findes ****************************************
	If oFileSystem.FileExists(sDestFilePath & "\" & sFile) Then

		'** Destinations fil eksisterer, kontroller om kilde fil er nyere **********
		Set oCopyFile = oFileSystem.GetFile(sSourceFilePath & "\" & sFile)
		Set oCopyFileDest = oFileSystem.GetFile(sDestFilePath & "\" & sFile)
		iSecondsDateDiff = DateDiff("s", oCopyFile.DateLastModified, oCopyFileDest.DateLastModified)
		If iSecondsDateDiff < 0 Then

			'** Kilde Fil er nyere, kopier fil *********************************
			On Error resume Next
			oCopyFile.Copy (sDestFilePath & "\" & sFile)
			If Err.Number = 0 Then
				'wscript.echo "File copied: "  & sSourceFilePath & "\" & sFile
			Else
				'** Fejl i kopiering, log fejl *****************************
				wscript.echo "ERROR " & Err.Number & " copy file: " & sSourceFilePath & "\" & sFile
			End If
			On Error Goto 0

		End If
		Set oCopyFile = nothing
		Set oCopyFileDest = nothing
	Else

		'** Destination findes ikke, kopier fil ************************************
		Set oCopyFile = oFileSystem.GetFile(sSourceFilePath & "\" & sFile)
		CreateFolderTree(sDestFilePath)
		On Error resume Next
		oCopyFile.Copy (sDestFilePath & "\" & sFile)

		'** Slet kilde fil, hvis kopiering gik godt ********************************
		If Err.Number = 0 Then
			'wscript.echo "File copied: "  & sSourceFilePath & "\" & sFile
		Else
			'** Fejl i kopiering, log fejl *************************************
			wscript.echo  "Error " & Err.Number & " copy file: " & sSourceFilePath & "\" & sFile

		End If
		On Error Goto 0
		Set oCopyFile = nothing
	End If
	Set oFileSystem = nothing
End Function


'****************************************************************************** 
Function CreateFolderTree(strInput)
	Dim objFileSystemObject
	Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
	If Not objFileSystemObject.FolderExists(strInput) Then 
		Dim arrFolderPath,intFolder,strFolderTree
		arrFolderPath = Split(strInput,"\")
		For intFolder = 0 To UBound(arrFolderPath)
			strFolderTree = strFolderTree & arrFolderPath(intFolder) & "\"
			If intFolder > 1 Then 
				If Not objFileSystemObject.FolderExists(strFolderTree) Then
					objFileSystemObject.CreateFolder(strFolderTree)
				End If
			End If
		Next
		CreateFolderTree = True
	Else
		CreateFolderTree = False
	End If
	Set objFileSystemObject = nothing
End Function

Run Hardware or Software Inventory

This function can be used to trigger a Hardware or Software inventory.

To trigger Hardware inventory call the function using:

RunInventory(“Hardware”)

To trigger Software inventory call the function using:

RunInventory(“Software”)

Sub RunInventory(StrType)

	If StrType = "Hardware" Then
		StrType = "Hardware Inventory Collection Cycle"
	ElseIf StrType = "Software" Then
		StrType = "Software Inventory Collection Cycle"
	Else
		Exit Sub
	End If

    ' Create the CPAppletMgr instance.
    Dim controlPanelAppletManager
    Set controlPanelAppletManager = CreateObject("CPApplet.CPAppletMgr")

    ' Get the available ClientActions object.
    Dim clientActions
    Set clientActions = controlPanelAppletManager.GetClientActions()

    ' Loop through the available client actions. Run the matching client action when it is found.
    Dim clientAction
    For Each clientAction In clientActions
        If clientAction.Name =  StrType  Then
            clientAction.PerformAction  
        End If
    Next
    

End Sub

Uninstall MSI if Installed for the Current User

This function takes an MSI product code as input and uninstalls the software if its installed for the current user (ProductState =5)

Sub UnInstPkg (StrProdCode)

Dim oWSHShell : Set oWSHShell = CreateObject("WScript.Shell")
Dim oMSI : Set oMSI = CreateObject("WindowsInstaller.Installer")
Dim UnInstVal : UnInstVal = 1

 Do While UnInstVal &lt;&gt; 0
  If oMSI.ProductState (StrProdCode) = 5 Then
   ReturnVal = oWSHShell.Run("MSIExec.exe /X " &amp; StrProdCode &amp; " /QB!-", 0, True)
   if Not (ReturnVal = 0 OR ReturnVal = 3010) then WScript.Quit ReturnVal
   UnInstPkg (StrProdCode)
  Else
   UnInstVal = 0
  End If

  Loop
End Sub

Prompt to set OSDComputerName

I use this script to set the computer name on virtual computers during task sequence.

The computer naming script in the task sequence is using the serial number which for virtual computers is too long and will cause the task sequence to fail. Therefore its needed to somehow change the computer name. I have placed this script on a network share which i map after the computer have been given the long and faulty serial-number name. The script will prompt for a new computer name which will then overwrite the OSDComputerName task sequence variable.

Set env = CreateObject("Microsoft.SMS.TSEnvironment")
 Set SWBemlocator = CreateObject("WbemScripting.SWbemLocator")
 Set objWMIService = SWBemlocator.ConnectServer(strComputer,"root\CIMV2",UserName,Password)
 Set colItems = objWMIService.ExecQuery("Select * from Win32_BIOS",,48)
 For Each objItem in colItems
   env("OSDComputerName") = InputBox("Please enter a Computer Name:", "Computer Name")
 Next

Windows Time Zone

I made a script to update the Windows Time Zone. In my example i want to use the Romance Standard time which is easily done by specifying this as an argument to the function SetTimeZone

SetTimeZone("Romance Standard Time")

Sub SetTimeZone(timezone)

On Error Resume Next

Set objSh = CreateObject("WScript.Shell")

Dim process, processid, strUpdateCommand
 Set process = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:Win32_process")

'Add time change privilege to the process object
 process.Security_.Privileges.AddAsString "SeSystemTimePrivilege",True
 strUpdateCommand = "control.exe timedate.cpl,,/Z" &amp; timezone

'Launch control.exe to refresh time zone information
process.create strUpdateCommand,Null,Null,processid

End Sub