troubleshooting Question

Need help creating a simple VBScript to change region settings in Vista

Avatar of David
DavidFlag for United Kingdom of Great Britain and Northern Ireland asked on
Windows VistaVB Script
4 Comments1 Solution2290 ViewsLast Modified:
Hi,

I need to create a couple of simple VBScripts that modify the region and time zone settings in Vista.
I must be able to execute one script to change from US to UK and then another to change back to US again. The change must take effect imediatly without having to restart at any point.

This is due to a CRM program our US sales guy is using requiring UK region and time zone settings while it syncs to our database in the UK. I just want to save him having to trawl through dialogue boxes every time he needs to sync, which will be most days.

I found some example code which I've attached. This sounds like it could be made to do what I want but it's way more complicated than what I need and I don't have enough VBScript knowledge to re-write it.

I'd be really greatful if someone could show me the basic code I need to do this.

Thanks,

David.
'********************************************************************
'* Goal
'* This script changes the Regional Settings in the Registry of a Win2K3 Server
'*
'* The script checks some things: is the server reachable, is the OS Win2K3,
'* are the Regional Settings correct (i.e. equal to the values in the script.)
'*
'********************************************************************
'* Prerequisites
'* Run the script with administrative privileges
'*
'********************************************************************
'* Changes
'* Version Name Date Comment
'* v.1.0 Corné Bogaarts 291204 Basic functionality works
'* v.1.1 Corné Bogaarts 210305 Made script less fragile by taking up
'* the settings in the script, instead of as
'* a separate textfile.
'* v.1.2 Corné Bogaarts 010505 Translated to English
'*
'* TODO: Have the script make the same changes to Current_User
'*
'********************************************************************
 
Option Explicit
'On Error Resume Next
 
Dim strLanguage, strNextLine, strKeyPath, strComputer, strItem
Dim strCollectionName, strEntryName, strValue, strSetting
 
Dim objCorrectSettings, objFSO, objSettingsFile, objReg, objWMIService
Dim objOperatingSystem, objCurrentSettings
 
Dim arrSetting, colOperatingSystems, arrEntryNames, arrValueTypes, arrValue
Dim byteValue, arrItem, blCompare
 
'*** Some constants for registry-editting
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_USER = &H80000001
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
'*** A constant for reading a file
Const ForReading = 1
 
'* Registry-path (in HK_Users) for Default-user
strKeyPath = ".DEFAULT\Control Panel\International"
 
strComputer = "."
 
'*** Make 2 dictionaries and set the 'compare-mode' (necessary
'*** for the comparison that we're going to make). The compare-
'*** mode must be set before any data is entered into the dic-
'*** tionary.
Set objCurrentSettings= CreateObject("Scripting.Dictionary")
objCurrentSettings.CompareMode = vbBinaryCompare
Set objCorrectSettings = CreateObject("Scripting.Dictionary")
objCorrectSettings.CompareMode = vbBinaryCompare
FillCorrectSettings
'PrintCollectionContents objCorrectSettings
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
'*** Connect to WMI (de CIMV2 namespace), necessary for most WMI-actions
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\cimv2")
'*** Connect to the WMI Registry-provider, necessary for working with the Registry
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
 
'* Verify the OS-version. If not Win2K3, than stop the script.
'*** Win2K = 5.0, WinXP = 5.1, Win2K3 = 5.2
Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
For Each objOperatingSystem in colOperatingSystems
' Wscript.Echo strComputer & vbTab & objOperatingSystem.Caption & vbTab & _
' objOperatingSystem.Version
If Left(objOperatingSystem.Version, 3) <> "6.0" Then
OsNotWin2K3
End If
Next
 
'* Verify if the Regional Settings are 'Nederlands'
'*** Check all settings, if 1 or more is not correct, then change all settings
ReadSettings strKeyPath, arrEntryNames
'*** To check the script, write the collection to the screen:
'PrintCollectionContents objCurrentSettings
 
'*** Compare the current with the correct settings:
blCompare = CompareSettings (objCorrectSettings, objCurrentSettings)
If blCompare = True Then
'*** all items are the same, so nothing has to be changed
WScript.Echo "All settings are already correct."
Else
'*** 1 or more items not the same, so make he changes
SetCorrectSettings
WriteEndMessage
End If
 
'*************************************************
'* Sub-routines
'*************************************************
Sub OsNotWin2K3
'* If the OS is not Win2003, then write a message to the screen and stop the script.
WScript.Echo "The Operating System on this server is not Windows Server 2003." & vbCrLf & _
"The script-execution will be stopped."
WScript.Quit
End Sub
 
Sub FillCorrectSettings
'* Fill the Dictionary with the correct settings
'*** You can copy these settings from the logfile that was
'*** written by the 'ReadRegionalSettings'-script.
objCorrectSettings.Add "iCountry", "31"
objCorrectSettings.Add "iCurrDigits", "2"
objCorrectSettings.Add "iCurrency", "2"
objCorrectSettings.Add "iDate", "1"
objCorrectSettings.Add "iDigits", "2"
objCorrectSettings.Add "iLZero", "1"
objCorrectSettings.Add "iMeasure", "0"
objCorrectSettings.Add "iNegCurr", "11"
objCorrectSettings.Add "iTime", "1"
objCorrectSettings.Add "iTLZero", "0"
objCorrectSettings.Add "Locale", "00000413"
objCorrectSettings.Add "s1159", ""
objCorrectSettings.Add "s2359", ""
objCorrectSettings.Add "sCountry", "Netherlands"
objCorrectSettings.Add "sCurrency", "?"
objCorrectSettings.Add "sDate", "-"
objCorrectSettings.Add "sDecimal", ","
objCorrectSettings.Add "sLanguage", "NLD"
objCorrectSettings.Add "sList", ";"
objCorrectSettings.Add "sLongDate", "dddd d MMMM yyyy"
objCorrectSettings.Add "sShortDate", "d-M-yyyy"
objCorrectSettings.Add "sThousand", "."
objCorrectSettings.Add "sTime", ":"
objCorrectSettings.Add "DefaultBlindDialFlag", "0"
objCorrectSettings.Add "sTimeFormat", "H:mm:ss"
objCorrectSettings.Add "iTimePrefix", "0"
objCorrectSettings.Add "sMonDecimalSep", ","
objCorrectSettings.Add "sMonThousandSep", "."
objCorrectSettings.Add "iNegNumber", "1"
objCorrectSettings.Add "sNativeDigits", "0123456789"
objCorrectSettings.Add "NumShape", "1"
objCorrectSettings.Add "iCalendarType", "1"
objCorrectSettings.Add "iFirstDayOfWeek", "0"
objCorrectSettings.Add "iFirstWeekOfYear", "2"
objCorrectSettings.Add "sGrouping", "3;0"
objCorrectSettings.Add "sMonGrouping", "3;0"
objCorrectSettings.Add "sPositiveSign", ""
objCorrectSettings.Add "sNegativeSign", "-"
objCorrectSettings.Add "Nation", "176"
End Sub
 
Sub ReadSettings (strKeyPath,arrEntryNames)
'* Read RegionalSettings from Registry and put them in a Dictionary
objReg.EnumValues HKEY_CURRENT_USER,strKeyPath,arrEntryNames,arrValueTypes
For Each strEntryName In arrEntryNames
'*** This is the only Binary value
If strEntryName = "DefaultBlindDialFlag" Then
objReg.GetBinaryValue HKEY_CURRENT_USER,strKeyPath,strEntryName,arrValue
For Each byteValue in arrValue
objCurrentSettings.Add strEntryName, byteValue
Next
Else
'*** These are all RegSZ value's
objReg.GetStringValue HKEY_CURRENT_USER,strKeyPath,strEntryName,strValue
objCurrentSettings.Add strEntryName, strValue
End If
Next
'*** This is the only value that's in a sub-key
strEntryName = "Nation"
objReg.GetStringValue HKEY_CURRENT_USER,strKeyPath & "\Geo",strEntryName,strValue
objCurrentSettings.Add strEntryName, strValue
End Sub
 
Sub PrintCollectionContents (strCollectionName)
'* Write the contents of a collection to the screen
'* Usefull for checking the script
WScript.Echo "Subroutine 'PrintCollectionContents'"
For Each strItem In strCollectionName
' WScript.Echo strItem & " = " & objDictionary.Item(strItem)
If strItem = "DefaultBlindDialFlag" Then
arrValue = Array(strCollectionName.Item(strItem))
For Each byteValue in arrValue
WScript.Echo strItem & " = " & byteValue
Next
ElseIf strItem = "Nation" Then
WScript.Echo strItem & " = " & strCollectionName.Item(strItem)
Else
WScript.Echo strItem & " = " & strCollectionName.Item(strItem)
End If
Next
WScript.Echo "End of subroutine 'PrintCollectionContents'"
End Sub
 
Function CompareSettings (objCorrectSettings, objCurrentSettings)
'* Compare the contents of both collections
'* If at least one item is not the same, then return-value = False
'* otherwise it's True.
'*** Rem: The value of 'DefaultBlindDialFlag' is not compared: technically more dificult as
'*** they're arrays, and the values don't seem important.
'*** --> can be added later
' WScript.Echo "Function CompareSettings"
CompareSettings = True
'*** Verify if all items of A are in B
For Each strSetting In objCorrectSettings
If NOT objCurrentSettings.Exists(strSetting) Then
' WScript.Echo vbTab & strSetting & " doesn't exist"
CompareSettings = False
Else 'if so, are the values the same?
If strSetting <> "DefaultBlindDialFlag" Then
If objCurrentSettings.Item(strSetting) <> objCorrectSettings.Item(strSetting) Then
WScript.Echo vbTab & strSetting & " not equal in both Dictionaries:" & _ 
objCorrectSettings.Item(strSetting) & " and " & objCurrentSettings.Item(strSetting)
CompareSettings = False
End If
End If
End If
Next
'*** Verify if all items of B are in A
For Each strSetting In objCurrentSettings
If NOT objCorrectSettings.Exists(strSetting) Then
' WScript.Echo vbTab & strSetting & " doesn't exist"
CompareSettings = False
Else 'if so, are the values the same?
If strSetting <> "DefaultBlindDialFlag" Then
If objCorrectSettings.Item(strSetting) <> objCurrentSettings.Item(strSetting) Then
WScript.Echo vbTab & strSetting & " not equal in bothDictionaries:" & _
objCorrectSettings.Item(strSetting) & " and " & objCurrentSettings.Item(strSetting)
CompareSettings = False
End If
End If
End If
Next
' WScript.Echo "CompareSettings = " & CompareSettings & "."
' WScript.Echo "End of Function CompareSettings"
If CompareSettings = False Then WScript.Echo "The settings in the Registry are not correct & _ and will be adjusted."
End Function
 
Sub SetCorrectSettings
'* Wite the correct settings to the Registry
' WScript.Echo "Subroutine SetCorrectSettings"
For Each strItem In objCorrectSettings
' WScript.Echo strItem & " = " & objDictionary.Item(strItem)
If strItem = "DefaultBlindDialFlag" Then
' WScript.Echo "Reg_Binary"
arrItem = Array(objCorrectSettings.Item(strItem))
RegEditBinary strKeyPath, strItem, arrItem
ElseIf strItem = "Nation" Then
' WScript.Echo "\Geo - Nation"
RegEditSZ strKeyPath & "\Geo", strItem,objCorrectSettings.Item(strItem)
Else
' WScript.Echo "Reg_SZ"
RegEditSZ strKeyPath, strItem,objCorrectSettings.Item(strItem)
End If
Next
WScript.Echo "Regional Settings adjusted."
' WScript.Echo "End of subroutine SetCorrectSettings"
End Sub
 
Sub RegEditSZ (strKeyPath, strEntryName, strValue)
'* Changing String-valued (REG_SZ) Entries
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strEntryName, strValue
End Sub
 
Sub RegEditBinary (strKeyPath, strEntryName, arrValue)
'* Changing Binary-valued (REG_Binary) Entries
'*** SetBinaryValue needs an Array as 'value', even if there's only 1 value in it
objReg.SetBinaryValue HKEY_CURRENT_USER, strKeyPath, strEntryName, arrValue
End Sub
 
Sub WriteEndMessage
'* Message on screen when script is finished.
WScript.Echo "Regional Settings adjusted." & vbCrLf & vbCrLf & "REMEMBER:" & vbCrLf & _
"The server needs to be restarted, before the new settings are activated."
End Sub
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 1 Answer and 4 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 4 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros