Comptage du nombre d'utilisateurs ayant accès à une ferme Citrix XenApp 5

'Extraction des groupes et users en accès sur une ferme Citrix XenApp 5
'Exploration des groupes de façon récursive (nested) pour en extraire tous les utilisateurs potentiels
'Au final calcul du nombre total d'utilisateurs uniques ayant accès à la ferme Citrix, qu'il soit dans un groupe ou non
'Version du 31 mars 2015

Sub DetectExeType()
	'Version du 10 juillet 2008

	Dim ScriptHost
	Dim ShellObject

	Dim CurrentPathExt
	Dim EnvObject

	Dim RegCScript
	Dim RegPopupType ' This is used to set the pop-up box flags.
											' I couldn't find the pre-defined names
	RegPopupType = 32 + 4

	On Error Resume Next

	ScriptHost = WScript.FullName
	ScriptHost = Right(ScriptHost, Len(ScriptHost) - InStrRev(ScriptHost, "\"))

	If (UCase(ScriptHost) = "WSCRIPT.EXE") Then
		WScript.Echo ("This script does not work with WScript.")

		' Create a pop-up box and ask if they want to register cscript as the default host.
		Set ShellObject = WScript.CreateObject("WScript.Shell")
		' -1 is the time to wait.  0 means wait forever.
		RegCScript = ShellObject.PopUp("Would you like to register CScript as your default host for VBscript?", 0, "Register CScript", RegPopupType)
		                                                    
		If (Err.Number <> 0) Then
			ReportError ()
			WScript.Echo "To run this script using CScript, type: ""CScript.exe " & WScript.ScriptName & """"
			WScript.Quit (GENERAL_FAILURE)
			WScript.Quit (Err.Number)
		End If

		' Check to see if the user pressed yes or no.  Yes is 6, no is 7
		If (RegCScript = 6) Then
			ShellObject.RegWrite "HKEY_CLASSES_ROOT\VBSFile\Shell\Open\Command\", "%WINDIR%\System32\CScript.exe //nologo ""%1"" %*", "REG_EXPAND_SZ"
			ShellObject.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\Open\Command\", "%WINDIR%\System32\CScript.exe //nologo ""%1"" %*", "REG_EXPAND_SZ"
			' Check if PathExt already existed
			CurrentPathExt = ShellObject.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PATHEXT")
			If Err.Number = &H80070002 Then
				Err.Clear
				Set EnvObject = ShellObject.Environment("PROCESS")
				CurrentPathExt = EnvObject.Item("PATHEXT")
			End If

			ShellObject.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PATHEXT", CurrentPathExt & ";.VBS", "REG_SZ"

			If (Err.Number <> 0) Then
				ReportError ()
				WScript.Echo "Error Trying to write the registry settings!"
				WScript.Quit (Err.Number)
			Else
				WScript.Echo "Successfully registered CScript"
			End If
		Else
			WScript.Echo "To run this script type: ""CScript.Exe adsutil.vbs <cmd> <params>"""
		End If

		Dim ProcString
		Dim ArgIndex
		Dim ArgObj
		Dim Result

		ProcString = "Cscript //nologo " & WScript.ScriptFullName

		Set ArgObj = WScript.Arguments

		For ArgIndex = 0 To ArgCount - 1
				ProcString = ProcString & " " & Args(ArgIndex)
		Next

		'Now, run the original executable under CScript.exe
		Result = ShellObject.Run(ProcString, 0, True)

		WScript.Quit (Result)
	End If

End Sub

'****************************************************************************
'
'pubAppRpt.vbs
'
'Description: Write to the cmd session a list of all published apps and the
'             users and groups assigned to them.
'
'Usage:       e.g. >cscript pubAppRpt.vbs
'
'****************************************************************************

Call DetectExeType()

Dim ListeDesGroupes


Dim mfFarm
Dim mfApp
Dim mfGrp
Dim mfUsr

Dim dicCitrixGroups 'Dictionnaire avec les groupes qui donnent accès à une appli Citrix
set dicCitrixGroups = CreateObject("Scripting.Dictionary")

Dim dicCitrixUsers 'Dictionnaire avec les users qui sont directement affectés à une appli Citrix
set dicCitrixUsers = CreateObject("Scripting.Dictionary")

Dim varListeGroupes, varListeComptes

varListeGroupes = ""
varListeComptes = ""

Set mfFarm = CreateObject("MetaFrameCOM.MetaFrameFarm")

if Err.Number <> 0 Then
	WScript.Echo "Can't create MetaFrameFarm object"
	WScript.Echo "(" & Err.Number & ") " & Err.Description
	WScript.Quit Err.Number
End if


mfFarm.Initialize 1
'mfFarm.Initialize(MetaFrameWinFarmObject)
if Err.Number <> 0 Then
	Wscript.Echo "Can't Initialize MetaFrameFarm object"
	Wscript.Echo "(" & Err.Number & ") " & Err.Description
	WScript.Quit Err.Number
End if

If mfFarm.WinFarmObject.IsCitrixAdministrator = 0 then
          Wscript.Echo "You must be a Citrix admin to run this script"
          WScript.Quit 0
End If

WScript.Echo "MetaFrame Farm Name: " & mfFarm.FarmName
WScript.Echo ""

WScript.Echo "Published Applications : "
WScript.Echo "Stockage dans 2 dictionnaires des groupes et users en accès sur la ferme Citrix " & mfFarm.FarmName & " : "
For Each mfApp In mfFarm.Applications

	mfApp.LoadData 1
	WScript.Echo vbTab & mfApp.Appname

	'WScript.Echo vbTab & vbTab & "Groups"
	For Each mfGrp In mfApp.Groups
		'WScript.Echo vbTab & vbTab & vbTab & mfGrp.GroupName
		'varListeGroupes = varListeGroupes & mfGrp.GroupName & ";"
		
		if dicCitrixGroups.Exists(mfGrp.GroupName) then
			'Do Nothing
		else
			'WScript.echo "Ajout d'un user : " & objMember.ADsPath
			'dicCitrixGroups.Add objMember.ADsPath, objMember.sAMAccountName
			If Len(Trim(mfGrp.GroupName)) > 0 Then dicCitrixGroups.Add mfGrp.GroupName, mfGrp.GroupName
		end if		
		
	Next

	'WScript.Echo vbTab & vbTab & "Users"
	For Each mfUsr In mfApp.Users
		'WScript.Echo vbTab & vbTab & vbTab & mfUsr.UserName
		'varListeComptes = varListeComptes & mfUsr.UserName & ";"

		if dicCitrixUsers.Exists(mfUsr.UserName) then
			'Do Nothing
		else
			'WScript.echo "Ajout d'un user : " & objMember.ADsPath
			'dicCitrixGroups.Add objMember.ADsPath, objMember.sAMAccountName
			If Len(Trim(mfUsr.UserName)) > 0 Then dicCitrixUsers.Add mfUsr.UserName, mfUsr.UserName
		end if
		
	Next

Next

Set mfFarm = Nothing

WScript.Echo ""
'WScript.Echo "varListeGroupes : " & varListeGroupes
'WScript.Echo "varListeComptes : " & varListeComptes

'Affichage des groupes en accès
ListeDesGroupes = ""
WScript.Echo ""
WScript.Echo "Groupes en accès sur une publication : "
varMesCles=dicCitrixGroups.keys
For varCompteur=0 To ubound(varMesCles)
	WScript.Echo VbTab & dicCitrixGroups.item(varMesCles(varCompteur))
	ListeDesGroupes = ListeDesGroupes & dicCitrixGroups.item(varMesCles(varCompteur)) & ";" 'Stockage des groupes en accès sur une publication Citrix dans une variable
Next
ListeDesGroupes = Left(ListeDesGroupes, Len(ListeDesGroupes)-1) 'On vire le ; en trop situé à droite

'Affichage des users en accès direct
WScript.Echo ""
WScript.Echo "Users en accès direct sur une publication Citrix : "
varMesCles=dicCitrixUsers.keys
For varCompteur=0 To ubound(varMesCles)
	'wscript.echo "dicCitrixUsers(" & varMesCles(varCompteur) & ")=" & dicCitrixUsers.item(varMesCles(varCompteur))
	'wscript.echo dicCitrixUsers.item(varMesCles(varCompteur))
	WScript.Echo VbTab & dicCitrixUsers.item(varMesCles(varCompteur))
Next

'Maintenant on va traiter les groupes membres des groupes
'WScript.Echo "Liste des groupes"
'WScript.Echo ListeDesGroupes
WScript.Echo ""
WScript.Echo "Exploration des membres contenus dans les groupes qui donnent accès à une publication Citrix"

'Option Explicit

Dim MyDistinguishedName
Dim objRootDSE, objItem, objConnection, objCommand, objRecordSet
Dim strContainer, strname
Dim intCounter
Dim dicSeenGroupMember 'Dictionnaire qui va contenir la liste des membres uniques de tous les groupes injectés en entrée
set dicSeenGroupMember = CreateObject("Scripting.Dictionary")
Dim varObjectCategory, varPosition
Dim varCompteur, varMesCles, varMesValeurs
Dim objFSO, objTextFile
Dim NomFichier, CheminFichier, CheminScriptActuel, ScriptFileName, Position
Dim CompteurTotal
Dim varUnGroup, varArrayGroups, varFiltreRequeteAD



strContainer = "" 'Si vous souhaitez vous connecter à une OU en particulié, indiquez la ici

Const ADS_UF_ACCOUNTDISABLE = 2 
Const ADS_SCOPE_SUBTREE = 2

Const ForReading = 1
Const ForWritting = 2
Const ForAppending = 8

ScriptFileName = wscript.scriptname
Position = InstrRev(ScriptFileName,".")
if (Position > 0) Then ScriptFileName = Left(ScriptFileName, Position - 1)

NomFichier = ScriptFileName & "_out.txt"

CheminScriptActuel = Left(wscript.scriptfullname,Len(wscript.scriptfullname)-Len(wscript.scriptname)-1)
CheminFichier = CheminScriptActuel & "\" & NomFichier 'Déclaration du chemin et du nom du fichier

If Len(CheminFichier) > 0 Then
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objTextFile = objFSO.OpenTextFile(CheminFichier, ForWritting, True)

	On Error Resume Next
	Set objRootDSE = GetObject("LDAP://rootDSE")
	If strContainer = "" Then
	  Set objItem = GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
	Else
	  Set objItem = GetObject("LDAP://" & strContainer & "," & _
		objRootDSE.Get("defaultNamingContext"))
	End If
	On Error Goto 0

	'strname = objItem.Get("name")
	'WScript.Echo "name: " & strname

	MyDistinguishedName = objItem.Get("distinguishedName") 'Récupération du distinguishedName du domaine par défaut. Exemple DC=Cotonso,DC=Com
	'WScript.Echo "distinguishedName: " & MyDistinguishedName

	Set objConnection = CreateObject("ADODB.Connection") 
	objConnection.Open "Provider=ADsDSOObject;" 
	Set objCommand = CreateObject("ADODB.Command") 
	objCommand.ActiveConnection = objConnection


	'Pour une liste de groupes donnés, on sort les membres
	varArrayGroups = Split(ListeDesGroupes, ";")
	varFiltreRequeteAD = ""
	For Each varUnGroup in varArrayGroups
		varFiltreRequeteAD = varFiltreRequeteAD & "(sAMAccountName=" & varUnGroup & ")"
	Next
	
	'WScript.echo "Filtre requete ldap pour les groupes : " & varFiltreRequeteAD
	
	'objCommand.CommandText = "<LDAP://" & MyDistinguishedName & ">;(objectCategory=Group);name,cn,displayName,sAMAccountName,distinguishedName,member;subtree"
	'objCommand.CommandText = "<LDAP://" & MyDistinguishedName & ">;(&(objectCategory=Group)(|(sAMAccountName=aeff1 nom affiche dans AD)(sAMAccountName=aeff2)));name,cn,displayName,sAMAccountName,distinguishedName,member,objectCategory;subtree"'
	objCommand.CommandText = "<LDAP://" & MyDistinguishedName & ">;(&(objectCategory=Group)(|" & varFiltreRequeteAD & "));name,cn,displayName,sAMAccountName,distinguishedName,member,objectCategory;subtree"'


	objCommand.Properties("Page Size") = 10000
	objCommand.Properties("Timeout") = 30
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	objCommand.Properties("Cache Results") = False

	'On liste les membres.
	'On ajoute dans le dictionnaire que les users qui n'y sont pas déjà
	'Si c'est un groupe, on liste les membres et on ajout les membres de type user au dictionnaire si ils n'y sont pas déjà. Si un membre est un groupe, on liste les membres de ce groupe etc ...


	Set objRecordSet = objCommand.Execute 
	intCounter = 0 
	Do Until objRecordset.EOF 
		'WScript.echo objRecordset.Fields("distinguishedName")
		'WScript.echo "Name : " & VbTab & objRecordset.Fields("Name")
		'WScript.echo VbTab & "cn : " & VbTab & objRecordset.Fields("cn")
		'WScript.echo VbTab & "displayName : " & VbTab & objRecordset.Fields("displayName")
		'WScript.echo VbTab & "sAMAccountName : " & VbTab & objRecordset.Fields("sAMAccountName")
		'WScript.echo VbTab & "distinguishedName : " & VbTab & objRecordset.Fields("distinguishedName")
		'WScript.echo VbTab & "objectCategory : " & VbTab & objRecordset.Fields("objectCategory")
		
		'WScript.echo "Exploration de " & objRecordset.Fields("distinguishedName")
		Call ExplorerGroupeEtAjoutMembresDansDico(objRecordset.Fields("distinguishedName"),dicSeenGroupMember)

		objRecordset.MoveNext 
	Loop 
	objConnection.Close

	
	'Le dico dicSeenGroupMember contient actuellement les membres des groupes qui étaient en accès sur la ferme Citrix
	'Il faut maintenant y ajouter les users qui sont directement en accès sur une appli de la ferme
	'Les users qui sont directement en accès sur une appli de la ferme sont dans le dico nommé
	
	WScript.Echo "Ajout au dictionnaire des users directement en accès sur une appli de la ferme : "
	varMesCles=dicCitrixUsers.keys
	For varCompteur=0 To ubound(varMesCles)
		varUnUserEnAccesDirect = dicCitrixUsers.item(varMesCles(varCompteur))
		WScript.Echo VbTab & varUnUserEnAccesDirect

		if dicSeenGroupMember.Exists(varUnUserEnAccesDirect) then
			'Do Nothing
		else
			WScript.echo VbTab & "Ajout de " & varUnUserEnAccesDirect
			dicSeenGroupMember.Add varUnUserEnAccesDirect, varUnUserEnAccesDirect
		end if

	Next	
		
	
	'On affiche le contenu du dico qui correspond aux membres des  groupes qui étaient en accès sur la ferme Citrix + les users qui ont un accès direct
	Wscript.echo "Ecriture dans le fichier des membres en accès sur la ferme Citrix"
	CompteurTotal = 0
	varMesCles=dicSeenGroupMember.keys
	For varCompteur=0 To ubound(varMesCles)
		'wscript.echo "dicSeenGroupMember(" & varMesCles(varCompteur) & ")=" & dicSeenGroupMember.item(varMesCles(varCompteur))
		'wscript.echo dicSeenGroupMember.item(varMesCles(varCompteur))
		objTextFile.WriteLine(dicSeenGroupMember.item(varMesCles(varCompteur)))
		CompteurTotal = CompteurTotal + 1
	Next
	objTextFile.WriteLine("")
	objTextFile.WriteLine("Nombre total de users uniques : " & CompteurTotal)
	
	objTextFile.Close 'Fermeture du fichier

	Set objTextFile = Nothing
	Set objFSO = Nothing
Else
	Wscript.echo "Operation annulee"
End If 'CheminFichier

Function ExplorerGroupeEtAjoutMembresDansDico (ByVal GroupDistinguishedName, ByRef dicSeenGroupMember)

	Dim ObjGroupAExplorer, objMember

	'Wscript.echo "Exploration du groupe " & GroupDistinguishedName
	
	Set ObjGroupAExplorer = GetObject("LDAP://" & GroupDistinguishedName)
	for each objMember In ObjGroupAExplorer.Members
		If objMember.Class = "group" Then
			'WScript.echo "Exploration du sous groupe " & objMember.distinguishedName
			Call ExplorerGroupeEtAjoutMembresDansDico(objMember.distinguishedName,dicSeenGroupMember)
		Else
			if dicSeenGroupMember.Exists(objMember.sAMAccountName) then
				'Do Nothing
			else
				'WScript.echo "Ajout d'un user : " & objMember.ADsPath
				'dicSeenGroupMember.Add objMember.ADsPath, objMember.sAMAccountName
				'dicSeenGroupMember.Add objMember.ADsPath, objMember.DisplayName
				dicSeenGroupMember.Add objMember.sAMAccountName, objMember.sAMAccountName
				CompteurTotal = CompteurTotal + 1
			end if
		End If
	next

End Function