Group Based Layer Activation Script

Here's an awesome script submitted by Juice reader Rene Meijer. The VBS script is designed to activate a layer based on membership in certain Active Directory groups.

Details

===================================================
'Script : gbla.vbs (Group Based Layer Activation)
'Author : René Meijer (rene.meijer@gmail.com)
'Date   : 12-4-2006
'------------------------------------------------------------------------------------
'This script is to be used with Altiris SVS. 
'The meaning is to Activate layers on bases of Groupmembership in Active Directory.
'The layers have to be imported through other methods (Altiris, SMS, etc.)
'
'How does it work ?
'------------------------------------------------------------------------------------
'What you have to do is to create an Application Security Group in Active Directory.
'In the Description of this group you specify the name (not case sensitive) of the Layer 
'of this Application. Users that are member of this group and where the layer is 
'imported on the computer will get the layer activated.

blDebug = True   'Set this to TRUE to create a logfile for debugging purposes

Dim arrLayers ()

Const ForAppending = 8
Const ADS_SCOPE_SUBTREE = 2
Const SVSPATH = "C:\Program Files\Altiris\Software Virtualization Agent\SVSCMD.exe"
Const SVSCMD = "SVSCMD.exe"
Const LOGFILE = "C:\gbla.log"

Set objShell = Wscript.CreateObject ("Wscript.Shell")
Set objFSO = CreateObject ("Scripting.FileSystemObject")
Set objWshScriptExec = objShell.Exec(SVSCMD & " ENUM")
Set objStdOut = objWshScriptExec.StdOut

if blDebug Then 
	'Create Logfile
	Set objLogFile = objFSO.CreateTextFile (LOGFILE,ForAppending)
	objLogFile.WriteLine "--------------------------------"
	objLogFile.WriteLine " * Debugging Enabled"
	objLogFile.WriteLine " * " & now
	objLogFile.WriteLine "--------------------------------"
End if

If objFSO.FileExists (SVSPATH) then
	'Do nothing. SVS agent is installed.
Else
	If blDebug then
		objLogFile.WriteLine " SVS agent not installed."
		objLogFile.WriteLine " Script quits."
		objLogFile.WriteLine "--------------------------------"
	else
		Wscript.echo "SVS agent not installed."
	end if
	Wscript.quit
End if

Set objRootDSE			= GetObject("LDAP://rootDSE")
Set objConnection		= CreateObject("ADODB.Connection")
Set objCommand			= CreateObject("ADODB.Command")
objConnection.Provider	= "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
strLDAPDomein	= objRootDSE.Get("defaultNamingContext")
strObjects		= "Name, Description, distinguishedName"
strGroupPreFix	= "AG-"
PreFixLen		= Len(strGroupPreFix)
objCommand.CommandText = "Select " & strObjects & " FROM " _
	& "'LDAP://" & strLDAPDomein & "' "_
	& "WHERE objectCategory='Group' AND objectClass='Group' AND " _
	& "Name='" & strGroupPreFix & "*'"
objCommand.Properties("Page Size")	= 1000
objCommand.Properties("Searchscope")= ADS_SCOPE_SUBTREE 
objCommand.Properties("Sort on")	= "Name"
Set objRecordSet = objCommand.Execute
strGetUserGroups = GetUserGroups
arrUserGroups = Split(strGetUserGroups, ";")
if blDebug then
	objLogFile.WriteLine " * Variables found:"
	objLogFile.WriteLine "--------------------------------"
	objLogFile.WriteLine " Domain		  : " & strLDAPDomein
	objLogFile.WriteLine " strGroupPreFix : " & strGroupPreFix
	objLogFile.WriteLine " PreFix Length  : " & PreFixLen
	objLogFile.WriteLine " Memberof Groups: " & strGetUserGroups
	objLogFile.WriteLine "--------------------------------"
end if
If ObjRecordset.RecordCount>0 then 
	objRecordSet.MoveFirst 
	Do Until objRecordSet.EOF
		For each strUserGroup in arrUserGroups
			if strUserGroup = objRecordset.Fields("Name").Value then
				if not IsNull(objRecordset.Fields("Description").Value) then
					strLayerName = Ucase(join(objRecordset.Fields("Description").Value))
					Activate(strLayerName)
				end if
			end if
		Next
		objRecordSet.MoveNext
	Loop
else
	'No applications groups found
	'Wscript.Echo "No applications groups found."
end if
Set objShell			= Nothing
Set objFSO				= Nothing
Set objRootDSE			= Nothing
Set objConnection		= Nothing
Set objCommand			= Nothing
Set objRecordSet		= Nothing
Set objWshScriptExec	= Nothing
Set objStdOut			= Nothing
'End of Main Script

Sub Activate(Layername)
	if blDebug then objLogFile.Writeline " Activating Layer : " & Layername
	x = 0
	preAmble = "Layer Name: " & vbTab & vbTab & vbTab
	Do Until objStdOut.AtEndOfStream
		Redim Preserve arrLayers(x+1)
		arrLayers(x) = Ucase(cstr(Replace(objStdOut.ReadLine,preAmble,""))) 
		if blDebug then objLogFile.WriteLine " Layer found : " & arrLayers(x)
		x = x + 1
	Loop
	Redim Preserve arrLayers(x-1)
	if LayerFound(Layername) then
		'Execute
		objShell.run SVSCMD & " """ & Layername & """ A",0,true
		if blDebug then objLogFile.WriteLine " Layer " & Layername & " activated."
	else 
		if blDebug then objLogFile.WriteLine " Layer " & Layername & " not found. Import this layer first."
	end if
End sub

Function GetUserGroups
	Dim objUser, objGroup
	Dim objNetwork
	Dim strUserName, strDomain, strUserGroups
	On Error Resume Next
	Set objNetwork = CreateObject("WScript.Network")
	strUserName = objNetwork.UserName
	strDomain = objNetwork.UserDomain
	Set objUser = GetObject("WinNT://" & strDomain & "/" & strUserName)
	For Each objGroup in objUser.Groups
			if left(objGroup.Name,PreFixLen) = strGroupPreFix then
				strUserGroups = strUserGroups & objGroup.Name & ";"
			end if
	Next
	GetUserGroups = Left(strUserGroups,(Len(strUserGroups)-1))
	Set objGroup = Nothing
	Set objUser = Nothing
	Set objNetwork = Nothing
End Function

Function LayerFound(Layer)
LayerFound = false
For x = 0 to Ubound(arrLayers)
	if arrLayers(x) = Layer then
		LayerFound = true
	End if
Next
End function