This was just an answer in a forum in September, but I keep getting requests for the script. So I am sharing it here for anyone that could be interested:
Problem: large amount of registered servers, multiple DBA's needing updated registration info, DBA workstations added or rebuilt, many servers added at once. In cases like these, manually rebuilding or updating the registration info is not nice ... 😉
With SQL7/NT4 we could save the registrations with a registry save/restore, but this doesn't work on SQL2K/W2K anymore. When trying the "Read from remote" option from EM, we found it was also not working (Q280836).
Using this DMO script we can solve it:
a) Run it on the "source" workstation with CSCRIPT //NOLOGO, it shows all the current registrations. Redirecting the output we create the configuration file.
b) We could make changes to this config file with Notepad, for example regrouping servers, or adding servers that are still not available.
c) Running the script on the "destination" machine with this config file as a parameter rebuilds the whole registration info according to the definitions.
Before this it drops all current EM configurations for your account (HKCU) and also any non-"user independent" EM registration (HKLM) (this is on purpose in order not to leave unsafe shared configurations laying around). As a safety measure, previously existing registration definitions are shown before being deleted.
Interesting side-note: standard security passwords are exposed by DMO without any restriction if you have access to the DBA workstation. Makes another good point for not using standard security. But if unavoidable, at least always use the "user independent" registration option ..., from another login you will not get access to them.
The script comments restrictions about special characters in server names, passwords and group names. Another disadvantage: it cannot handle "
Distribution of Enterprise Manager registrations
'************************************************************************
'* SCRIPT TO SHOW SQL ENTERPRISE MANAGER REGISTRATION INFO AND *
'* TO REBUILD REGISTRATION INFO BASED ON A CONFIGURATION FILE *
'* THAT CAN BE THE CAPTURED FROM THE OUTPUT OF THIS SCRIPT *
'* *
'* Gustavo Merle - 08-Aug-2003 *
'************************************************************************
'????????????????????????????????????????????????????????????????????????
'
' *** WARNING ****
'
' Enterprise Manager can store SQL Server registration information in
' HKLM (available to every user connecting to the machine) or in HKCU
' (only for currently logged in user).
'
' When registering with standard security, the password is hidden in
' Enterprise Manager, and encrypted in the registry. BUT!!! WITH A
' VERY SIMPLE SQLDMO SCRIPT (as this script shows) THE PASSWORD CAN BE
' RETRIEVED IN CLEAR TEXT!!
'
' What this means is that when using the shared mode (HKLM) it is trivial
' for anyone logging in into the machine to retrieve the sa password
' (for example Asset Deployment, Domain Admins, etc). This is a high
' security risk.
'
' If a reason to use shared mode was to simplify the management of
' all the server registrations for different DBAs in different
' monitoring machines, the goal of this script is to simplify this
' process, but keeping the registration information in everyone's own
' profiles and not publicly available.
'
' *** WARNING ****
'
' The output created by this script contains SQL registration info,
' INCLUDING THE SA PASSWORD IN CLEARTEXT. Please always handle this
' output information (and also if possible this same script) very
' carefully (ZIP files with sa password encryption?) and delete any
' copies that could remain.
'
'????????????????????????????????????????????????????????????????????????
'========================================================================
'USAGE: When executed with CSCRIPT //NOLOGO without parameters, an output
' is generated showing all groups and server registration info from
' Enterprise Manager. If this output is captured to a file, it can
' be used to later rebuild the same registration info on another
' Enterprise Manager.
' The output generated shows both the registrations for the current
' profile (HKCU) and also "shared" registrations (HKLM).
' If "blnShowProperties" is changed from False to True, additional
' Properties information is shown.
'
' When executed with a filename as parameter, the script REBUILDS
' the registration information for Enterprise Manager based on the
' information contained in the file.
' 1) It first wipes out the whole "shared" registrations.
' 2) Then it also wipes out the whole existing "user independent"
' registrations.
' 3) Afterwards the groups and server registrations listed in the
' configuration file are created (see notes below) in the
' "user independent" (HKCU) mode.
' 4) The Enterprise Manager is left configured in the "user
' independent" mode.
' Any error breaks the execution of the script.
'
' Just in case: backup following registry folders before applying
' the changes:
' HKLM\SOFTWARE\Microsoft\Microsoft SQL Server\80\Tools\SQLEW
' HKCU\Software\Microsoft\Microsoft SQL Server\80\Tools\SQLEW
'
' See below the description of the configuration file format.
'========================================================================
'========================================================================
'WARNING: CLOSE ENTERPRISE MANAGER BEFORE EXECUTING THIS SCRIPT TO WRITE
' REGISTRATION INFO, FOR THE CHANGES OF THIS SCRIPT NOT TO BE
' OVERWRITTEN BY CHANGES IN ENTERPRISE MANAGER'S CACHE WHEN
' CLOSING IT !!
'========================================================================
'------------------------------------------------------------------------
'NOTE 1: The option "Display SQL Server state in console", accessible via
' Edit SQL Server Registration properties ... | General | Options
' cannot be managed by this script. Registrations created by this
' script will always have this option disabled... (Nikola, any
' suggestions? ...) RegisteredServer.PersistFlags returns only 2
' bits for the other 2 options ("show system objects" and "auto
' restart"). I played setting more bits in PersistFlags when
' registering, but the extra bits are ignored...
'------------------------------------------------------------------------
'------------------------------------------------------------------------
'NOTE 2: The Enterprise Manager Server Registration options include "Show
' system databases and system objects" and "Automatically start
' SQL Server when connecting". When this script is executed to
' list the current registration information, these options are
' shown as:
'
' {__} : no autostart, no sys
' {_S} : no autostart, sys *** PREFERRED MODE ***
' {A_} : autostart, no sys
' {AS} : autostart, sys *** default options when registering ***
' *** via Enterprise Manager ***
'
' But when the script is executed to create the registrations, these
' options are ignored, and the options {_S} are always set to show
' all DBs and system objects, and to avoid accidentally starting a
' SQL Server that was stopped on purpose (or a cluster that needs to
' be handled via the Cluster Administrator!)
'------------------------------------------------------------------------
'------------------------------------------------------------------------
'NOTE 3: In SQL 2000 Enterprise Manager the option to read registration
' information from a remote server does not work. This script
' overrides this setting to always read it locally (even when
' executed to only show registration information).
'------------------------------------------------------------------------
'------------------------------------------------------------------------
'WARNING: For simplicity, THIS SCRIPT DOES NOT HANDLE SPACES OR TABS IN
' SERVER NAMES, USER NAMES OR PASSWORDS. Server names cannot
' contain "[". Spaces are handled correctly only for Group names.
' Group names cannot contain the "]" character. Blanks are also
' not supported in account names and passwords.
'------------------------------------------------------------------------
'========================================================================
'CONFIGURATION FILE FORMAT:
'
' - Tab characters are interpreted as spaces
' - Blank lines are ignored
' - Leading spaces are only considered for group hierarchy, and ignored
' for the rest of the lines
' - Lines beginning (after the leading spaces) with "--" are ignored
' - Groups are defined enclosed in []. A line is considered a group
' definition only if the first character after the leading spaces is a
' "[". Everything after the (first) closing "]" is ignored. If "]" is
' missing, the whole line (after "[") is considered the group name.
' - Any line before the first group definition is ignored.
' - The first group definition gets level 1
' - Increasing indentation increases the group hierarchy level by 1
'
' - Decreasing indentation only lowers the new group's hierarchy when
' reaching or crossing the n-1 level's group indentation
' Example: ("." shown for spaces) Creates:
' -------- --------
' ..[GROUP1] level 1 +- GROUP1
' ......[GROUP2] level 2 | +- GROUP2
' ...[GROUP3] level 2 | +- GROUP3
' ....[GROUP4] level 3 | +- GROUP4
' [GROUP5] level 1 +- GROUP5
'
' - Server definition lines (one server per line) are applied to the
' last defined group (indentation is ignored for server definitions)
' - Server definition lines consist of several fields separated by 1 or
' more spaces:
' a) 0 or more leading spaces (irrelevant)
' b) servername (no spaces in name)
' c) type of registration:
' (t) trusted connection
' (S) standard security
' (P) standard security but prompting for password when
' connecting
' d) login (ignored for (t))
' e) password (ignored for (t) and (P))
' f) {__} | {A_} | {_S} | {AS} (see NOTE 2)
' ignored during creation of registrations
' g) any further field is also ignored
'========================================================================
'
'Registry location for Enterprise Manager user related registration Info:
'"HKEY_CURRENT_USER\Software\Microsoft\Microsoft SQL Server\80\Tools\SQLEW\"
'Enterprise Manager - Tools - Options - General
'- Server registration information - Read from remote - Server Name:
'
'With "SQLDMO.Application":
'GroupRegistrationServer = '' local, 'XXX' remote server
'(with UseCurrentUserServerGroups False when server specified)
'
'From Registry:
'RegisteredServersSource REG_SZ '' local, 'XXX' remote server
'(with UserRegistrationInfo 0x0 when server specified)
'
'Remote Server source doesn't work in SQL 2000 so we set it to local
'
'Enterprise Manager - Tools - Options - General
'- Server registration information - Read/Store locally
'- Read/Store user independent
'
'With "SQLDMO.Application":
'UseCurrentUserServerGroups = True user indep, False shared
'
'From Registry:
'UserRegistrationInfo REG_DWORD 0x1 user indep, 0x0 shared
'
'Shared: uses LocalMachine, User Independent: uses CurrentUser
'
'Registry location for Enterprise Manager shared server registration Info:
'"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Microsoft SQL Server\80\Tools\SQLEW\"
'"Registered Servers X"\[EntMgrGroup]
'
'Registry location for Enterprise Manager user indep server registration Info:
'"HKEY_CURRENT_USER\Software\Microsoft\Microsoft SQL Server\80\Tools\SQLEW\"
'"Registered Servers X"\[EntMgrGroup]
'
'...........................................................................
'Initialization:
'
option explicit
'DEBUG:
dim blnShowProperties
blnShowProperties = False 'show all properties of registration objects
'and details of registrations rebuild
'...........................................................................
'Parameters Handling:
'
dim intArgCount
intArgCount = WScript.Arguments.Count
dim strMsg
If intArgCount > 1 then
strMsg = "Invalid Parameters: " + vbCrLf
strMsg = strMsg + " - no parameters: create list"+ vbCrLf
strMsg = strMsg + " - one parameter: config file to rebuild registrations"
MsgBox strMsg
WScript.Quit 1
End If
dim strFile, objFSO
If intArgCount = 1 then
strFile = WScript.Arguments(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")
If not objFSO.FileExists(strFile) then
MsgBox "ERROR: File """& strFile & """ does not exist!"
Set objFSO = nothing
WScript.Quit 1
End If
End If
'...........................................................................
'DMO Object to manage registrations (not server-bound):
'
dim objDMO
Set objDMO = CreateObject ("SQLDMO.Application")
'Remote Server source doesn't work in SQL 2000 so we set it to local here:
objDMO.GroupRegistrationServer = "" ' local
'...........................................................................
'LIST REGISTRATIONS
'This is the only section executed when no parameters are specified
'
If intArgCount = 0 then showRegistrations ""
'...........................................................................
'REBUILD REGISTRATIONS
'
'This section is only executed when a configuration file was specified
'as parameter.
'The wipe-out process of existing registrations is only started if at
'least one valid group definition was found in the configuration file.
'
If intArgCount = 1 then ' rebuild registrations
'First show pre-existing registrations
showRegistrations " INITIAL"
'All pre-existing shared and user-independent registrations will be
'deleted once we find a first valid group line in the configuration file
'Tracking of group definitions. Ignore lines before first group
dim blnGroupFound
blnGroupFound = False
'Dictionary object to track levels of groups
dim objLevels
Set objLevels = CreateObject("Scripting.Dictionary")
'Track current level
dim intCurrLevel
intCurrLevel = 0
'Object positioned in current group
dim objCurrGroup
Set objCurrGroup = objDMO ' initially in Application level
'Output string initialization
dim strList
strList = "-- REGISTRATIONS BASED ON " & strFile & vbCrLf
dim objFile, intLineNr, strLine
Const ForReading = 1, CreateFalse = False
Set objFile = objFSO.OpenTextFile(strFile, ForReading, CreateFalse)
Do until objFile.AtEndOfStream
intLineNr = objFile.Line ' positioned before next line to read
strLine = Replace(objFile.ReadLine, vbTab, " ") ' tabs as spaces
'GROUP LINE ----------------------------------------------------------------
If fnIsGroup (strLine) then 'Group line
If blnGroupFound = False then 'if it's the first group we find ...
'Only after we find the first valid group we remove ALL existing
'registrations. (Only root groups need to be removed, because the
'Remove method deletes everything below - subgroups and servers).
dim objSubGroup
'1st: delete all shared registrations:
objDMO.UseCurrentUserServerGroups = False ' shared
objDMO.ServerGroups.Refresh
For each objSubGroup in objDMO.ServerGroups
objSubGroup.Remove
Next
strList = strList & "--------------------------------------------" & vbCrLf
strList = strList & "-- SHARED REGISTRATIONS DELETED !!" & vbCrLf
'2nd: delete all 'user independent' registrations:
objDMO.UseCurrentUserServerGroups = True ' user independent
objDMO.ServerGroups.Refresh
For each objSubGroup in objDMO.ServerGroups
objSubGroup.Remove
Next
strList = strList & "--------------------------------------------" & vbCrLf
strList = strList & "-- USER INDEPENDENT REGISTRATIONS DELETED !!" & vbCrLf
strList = strList & "--------------------------------------------" & vbCrLf
'set flag that we are already processing groups so we stop ignoring input lines
'and do not delete the registrations again.
blnGroupFound = True
End If
dim intIndent, strGroup
getGroupInfo strLine, intIndent, strGroup
dim intNewLevel
'Obtain the level where the new group should belong to
intNewLevel = newLevel(intIndent, objLevels, strGroup)
'Position objCurrGroup to create the new group
gotoLevel intNewLevel - 1, objCurrGroup, intCurrLevel, objLevels
intCurrLevel = intNewLevel - 1
'Try to create the group
dim objNewGroup
Set objNewGroup = CreateObject ("SQLDMO.ServerGroup")
objNewGroup.Name = strGroup
objCurrGroup.ServerGroups.Add objNewGroup
Set objNewGroup = nothing
'Everything OK, group created. Goto to the group
Set objCurrGroup = objCurrGroup.ServerGroups.Item(strGroup)
intCurrLevel = intNewLevel
strList = strList & intLineNr & ": ** GROUP (L" & intNewLevel & "): """ & _
strLine & """ created." & vbCrLf
'IGNORED LINE --------------------------------------------------------------
ElseIf not blnGroupFound or fnToIgnore (strLine) then 'Line to ignore
'also ignore everything before first group
strList = strList & intLineNr & ": -- IGNORED: """ & strLine & """" & vbCrLf
'SERVER LINE ---------------------------------------------------------------
ElseIf fnValidServer (strLine) then 'Server registr line
dim strServer, strMode, strLogin, strPassword
getServerInfo strLine, strServer, strMode, strLogin, strPassword
'Create the new server registration:
dim objNewRegisteredServer
Set objNewRegisteredServer = CreateObject ("SQLDMO.RegisteredServer")
objNewRegisteredServer.Name = strServer
Select Case strMode
case "(S)" objNewRegisteredServer.UseTrustedConnection = 0
case "(t)" objNewRegisteredServer.UseTrustedConnection = 1
case "(P)" objNewRegisteredServer.UseTrustedConnection = 2
End Select
If strMode = "(S)" or strMode = "(P)" then
objNewRegisteredServer.Login = strLogin
End If
If strMode = "(S)" then
objNewRegisteredServer.Password = strPassword
End If
' " {_S} " ' no autostart, system objects *** PREFERRED MODE ***
objNewRegisteredServer.PersistFlags = 1
'Add the server:
objCurrGroup.RegisteredServers.Add objNewRegisteredServer
'Cleanup:
Set objNewRegisteredServer = nothing
strList = strList & intLineNr & ": ## SERVER: """ & strLine & """ created." & vbCrLf
'INVALID LINE --------------------------------------------------------------
Else 'Invalid line
strList = strList & intLineNr & ": ?? INVALID LINE IGNORED: """ & strLine & """" & vbCrLf
End If
Loop
strList = strList & "-- END REGISTRATIONS CREATION" & vbCrLf & vbCrLf
objFile.Close
Set objFile = nothing
Set objLevels = nothing
Set objCurrGroup = nothing
If blnShowProperties then WScript.Echo strList
'show what remained from the registrations:
showRegistrations " FINAL"
End If
'Cleanup
Set objDMO = nothing
If intArgCount = 1 then Set objFSO = nothing
WScript.Quit 0
'
' END OF SCRIPT - Start of auxiliary functions
'...........................................................................
'------------------------------------------------------------------------------------------
'Procedures to show existing registrations
'
Sub showRegistrations (strAux)
dim strList, strPrefix, strTitle
'First show (local) shared registrations:
objDMO.UseCurrentUserServerGroups = False ' shared
strTitle = "-- ##" & strAux & " SHARED REGISTRATIONS ## -------------------"
strList = strTitle & vbCrLf
strPrefix = "-- "
listGroups objDMO, strList, strPrefix
'Now show user independent registrations:
objDMO.UseCurrentUserServerGroups = True ' user independent
strTitle = "-- ##" & strAux & " USER INDEPENDENT REGISTRATIONS ## ---------"
strList = strList & vbCrLf & strTitle & vbCrLf
strPrefix = ""
listGroups objDMO, strList, strPrefix
'End
strTitle = "-- ## END" & strAux & " REGISTRATIONS ## ----------------------"
strList = strList & strTitle & vbCrLf
WScript.Echo strList
End Sub
Sub listGroups (objRoot, strList, strPrefix)
'show properties on top for the case we want to see properties
'of SQLDMO.Application (root group):
If blnShowProperties Then showProperties objRoot, strList, strPrefix
' show servers in this group
listServersInGroup objRoot, strList, strPrefix
'show subgroups
dim objSubGroups, objSubGroup
Set objSubGroups = objRoot.ServerGroups
objSubGroups.Refresh
For each objSubGroup in objSubGroups
'show group name here and not on top in order not to show [Microsoft
'SQL-DMO] for the root that is not an Enterprise Manager group:
strList = strList & strPrefix & "[" & objSubGroup.Name & "]" & vbCrLf
listGroups objSubGroup, strList, strPrefix & " "
Next
Set objSubGroups = nothing
End Sub
Sub listServersInGroup (objRoot, strList, strPrefix)
dim objRegisteredServers, objRegisteredServer
On Error Resume Next
Set objRegisteredServers = objRoot.RegisteredServers
If err.number = 0 then ' root folder does not support servers, only groups
On Error Goto 0
objRegisteredServers.Refresh
For each objRegisteredServer in objRegisteredServers
showServerDetails objRegisteredServer, strList, strPrefix
Next
else
On Error Goto 0
End If
Set objRegisteredServers = nothing
End Sub
Sub showServerDetails (objServer, strList, strPrefix)
strList = strList & strPrefix & objServer.Name
Select Case objServer.UseTrustedConnection
case 0 strList = strList & " (S)" ' standard
case 1 strList = strList & " (t)" ' trusted
case 2 strList = strList & " (P)" ' standard with prompt
case else strList = strList & " (?)" '
End Select
strList = strList & " " & objServer.Login
strList = strList & " " & objServer.Password
' 0 PersistFlags
' Show system databases and system objects
' Automatically start SQL Server when connecting
'
' 1 PersistFlags
' X Show system databases and system objects
' Automatically start SQL Server when connecting
'
' 2 PersistFlags
' Show system databases and system objects
' X Automatically start SQL Server when connecting
'
' 3 PersistFlags
' X Show system databases and system objects
' X Automatically start SQL Server when connecting
'
Select Case objServer.PersistFlags
case 0 strList = strList & " {__} " ' no autostart, no sys
case 1 strList = strList & " {_S} " ' no autostart, sys *** PREFERRED MODE ***
case 2 strList = strList & " {A_} " ' autostart, no sys
case 3 strList = strList & " {AS} " ' autostart, sys
case else strList = strList & " {??} " '
End Select
strList = strList & vbCrLf
If blnShowProperties Then
showProperties objServer, strList, strPrefix
End If
End Sub
Sub showProperties (obj, strList, strPrefix)
dim oProp, Value
For each oProp in obj.Properties
strList = strList & strPrefix & " -- # " & oProp.Name
Value = oProp.Value
strList = strList & ": " & Value & vbCrLf
Next
End Sub
'------------------------------------------------------------------------------------------
'Functions and procedures to parse configuration file for registrations creation
'
Function fnIsGroup (strLine)
dim objRE
Set objRE = new RegExp
objRE.IgnoreCase = False
objRE.Global = False
objRE.MultiLine = False
'ignore leading spaces, opening "[", at least one non-"]"
objRE.pattern = "^ *\[[^\]]+"
fnIsGroup = objRE.Test(strLine)
Set objRE = nothing
End Function
Function fnToIgnore (strLine)
dim objRE
Set objRE = new RegExp
objRE.IgnoreCase = False
objRE.Global = False
objRE.MultiLine = False
'ignore blank lines or starting with -- after blanks
objRE.pattern = "^ *(?:$|--)"
fnToIgnore = objRE.Test(strLine)
Set objRE = nothing
End Function
Function fnValidServer (strLine)
dim objRE
Set objRE = new RegExp
objRE.IgnoreCase = True 'don't care if (t) or (T)
objRE.Global = False
objRE.MultiLine = False
'registr trusted SERVER (t) |
'registr std prompt SERVER (P) login |
'registr standard SERVER (S) login password
objRE.pattern = "^ *[^ ]+ +(?:\(t\)|\(P\) +[^ ]+|\(S\) +[^ ]+ +[^ ]+)"
fnValidServer = objRE.Test(strLine)
Set objRE = nothing
End Function
Sub getGroupInfo (byVal strLine, byRef intIndent, byRef strGroup)
dim objRE
intIndent = NULL
strGroup = NULL
Set objRE = new RegExp
objRE.IgnoreCase = False
objRE.Global = False
objRE.MultiLine = False
'leading spaces define group level
'group name starts after [, until ] or EOL
objRE.pattern = "^( *)\[([^\]]+)"
dim objMatches
Set objMatches = objRE.Execute(strLine)
If objMatches.Count > 0 Then
dim objMatch
Set objMatch = objMatches(0) 'only the first one
If objMatch.Submatches.Count > 0 Then
intIndent = Len(objMatch.Submatches(0))
End If
If objMatch.Submatches.Count > 1 Then
strGroup = objMatch.Submatches(1)
End If
Set objMatch = nothing
End If
Set objMatches = nothing
Set objRE = nothing
End Sub
Sub getServerInfo (byVal strLine, byRef strServer, byRef strMode, byRef strLogin, byRef strPassword)
dim objRE
strServer = NULL
strMode = NULL
strLogin = NULL
strPassword = NULL
Set objRE = new RegExp
objRE.IgnoreCase = True 'don't care if (t) or (T)
objRE.Global = False
objRE.MultiLine = False
'registr trusted SERVER (t) |
'registr std prompt SERVER (P) login |
'registr standard SERVER (S) login password
objRE.pattern = "^ *([^ ]+) +(?:(\(t\))|(\(P\)) +([^ ]+)|(\(S\)) +([^ ]+) +([^ ]+))"
'submatches ( 0 ) { ( 1 )|( 2 ) ( 3 )|( 4 ) ( 5 ) ( 6 )}
'this pattern returns always 7 submatches, and depending on the or condition
'the rest of the submatches show up as empty
dim objMatches
Set objMatches = objRE.Execute(strLine)
If objMatches.Count > 0 Then
dim objMatch
Set objMatch = objMatches(0) 'only the first one
If objMatch.Submatches.Count > 0 Then
strServer = UCase(objMatch.Submatches(0)) 'Server registration uppercase
End If
If objMatch.Submatches.Count > 1 and not IsEmpty(objMatch.Submatches(1)) Then
strMode = "(t)"
End If
If objMatch.Submatches.Count > 2 and not IsEmpty(objMatch.Submatches(2)) Then
strMode = "(P)"
End If
If objMatch.Submatches.Count > 3 and not IsEmpty(objMatch.Submatches(3)) Then
strLogin = objMatch.Submatches(3)
End If
If objMatch.Submatches.Count > 4 and not IsEmpty(objMatch.Submatches(4)) Then
strMode = "(S)"
End If
If objMatch.Submatches.Count > 5 and not IsEmpty(objMatch.Submatches(5)) Then
strLogin = objMatch.Submatches(5)
End If
If objMatch.Submatches.Count > 6 and not IsEmpty(objMatch.Submatches(6)) Then
strPassword = objMatch.Submatches(6)
End If
Set objMatch = nothing
End If
Set objMatches = nothing
Set objRE = nothing
End Sub
'........................................................................................
' Levels of groups are defined by the indentation of the group name in the
' configuration file.
' The first group defined is level 1
' The "current level" is the level of the last group defined
' If a new group is defined:
' - If the indentation is higher than the indentation of the group that
' defined the current level Ln, it gets level Ln+1
' - If the indentation is the same as the indentation of the group that
' defined the current level Ln, it also gets level Ln
' - If the indentation is lower than the indentation of the group that
' defined the current level Ln, the level it gets depends on the
' indentation of the groups that defined the current "path" of levels:
' Indentation (spaces) Level
' ---------------------- -------
' S1 L1 S1 >= 0
' S2 L2 S2 > S1
' ... ...
' Sn-2 Ln-2
' Sn-1 Ln-1
' Sn Ln << Current level
'
' Sn > Sn-1 > Sn-2
'
' New group with Sx < Sn is level Ln if Sn-1 < Sx <= Sn
' New group with Sx < Sn is level Ln-1 if Sn-2 < Sx <= Sn-1
' ....
' New group with Sx < Sn is level L2 if S1 < Sx <= S2
' New group with Sx < Sn is level L1 if 0 <= Sx <= S1
'
' A Dictionary object is used to track the the indentation levels
' only of the groups that define the path from the root to the current
' group. Key is the level and the value is the indentation (amount of
' spaces).
'The function receives the indentation of a new
'group definition and the group name, and returns
'the level this new group belongs to. The dictionary
'object tracks the path to the current group from
'the root, and the group name at each level
Function newLevel(intIndent, objLevels, strGroup)
'normalize parameter
If not IsNumeric(intIndent) or intIndent < 0 then
newLevel = NULL
exit Function
End If
'discard eventual fractional parts
intIndent = Int(intIndent)
'if first element ...
If objLevels.count = 0 then
objLevels.add 1, Array(intIndent, strGroup)
newLevel = 1
exit Function
End If
'if higher indentation as current ...
If intIndent > objLevels.Item(objLevels.count)(0) then
objLevels.add (objLevels.count+1), Array(intIndent, strGroup)
newLevel = objLevels.count
exit Function
End If
'if same indentation as current ...
If intIndent = objLevels.Item(objLevels.count)(0) then
'replace with new group name
objLevels.Remove(objLevels.count)
objLevels.add (objLevels.count+1), Array(intIndent, strGroup)
newLevel = objLevels.count
exit Function
End If
'if lower indentation as current ...
If intIndent < objLevels.Item(objLevels.count)(0) then
'first remove current last level
objLevels.Remove(objLevels.count)
'and try again ...
newLevel = newLevel(intIndent, objLevels, strGroup)
exit Function
End If
End Function
'------------------------------------------------------------------------------------------
'Functions and procedures to create groups and server registrations
'
Sub gotoLevel (byVal intDestLevel, byRef objCurrGroup, byVal intCurrLevel, byVal objLevels)
'parent property not supported on newly created groups to back-track,
'so we go up from the root level ...
If intDestLevel = intCurrLevel then exit Sub
If intDestLevel > intCurrLevel then
'We can only go down, we should never get a request to go up...
'Put the object in an invalid state to abort script
Set objCurrGroup = nothing
objCurrGroup = NULL
exit Sub
End If
'From here we only have reuquests to go down
If intCurrLevel <= 0 then
'We cannot go down from level 0 (.. or less) ...
'Put the object in an invalid state to abort script
Set objCurrGroup = nothing
objCurrGroup = NULL
exit Sub
End If
'Here we only have valid requests to descend one or more levels:
'But we start from Level 0 going up up to intDestLevel
Set objCurrGroup = objCurrGroup.Application
intCurrLevel = 0
While intCurrLevel < intDestLevel
intCurrLevel = intCurrLevel + 1
dim strCurrGroup
strCurrGroup = objLevels.Item(intCurrLevel)(1)
Set objCurrGroup = objCurrGroup.ServerGroups.Item(strCurrGroup)
Wend
End Sub