by
Brian Madden
Jeff Durbin has written a pretty cool VBS script that calculates how many unique users have access to each published application in a farm, as well as how many unique users have access to the farm as a whole. It then dumps all of this data to an Excel spreadsheet. Below you'll find a screenshot of the output, and the VBS code itself.
The VBS script begins below. Just copy this text, paste it into notepad, and change the file extensio to .VBS to use it. More help is available in the script itself.
Option Explicit
'==========================================================================
'
' NAME: ListPotentialFarmUsersExcel.vbs
'
' AUTHOR: Jeff Durbin
' jeffdurbin@gmail.com
'
' DATE : 3/22/2006
'
' COMMENT: The purpose of this script is to find out how many unique
' users have access to each published application in a Citrix
' farm. To find the number for a given application, you need
' to look at the users and groups to which the application is
' published. You then have to query the members of each group,
' but only counting the users that have not been previously
' counted, either as an individual user to which the app is
' published, or as a member of a different group to which
' the application is published, and to which the user belongs.
' This script does that, keeping track not only at the
' published application level, but at the farm level. The
' resulting numbers indicate how many unuque users have access
' to each published application, and how many unique users
' have access to at least one application in the farm.
'
' Usage: cscript ListPotentialFarmUsersExcel.vbs
'
' The script has the following requirements:
'
' 1. Must be started from the command line using CSCRIPT
' 2. Run it from a machine that has Excel installed
' 3. Run it from a MetaFrame/CPS server in the farm
' 4. You must be at least a View-Only admin on the farm
'
' Limitations: Sorry, but the script doesn't process nested groups. If
' you publish apps to groups that have groups as members,
' they will not be counted properly. Maybe if I get some
' spare time (lol), I'll add that.
'
' Notes: Enjoy the script, and email any feedback to the address above.
'
'==========================================================================
On Error Resume Next
Const cMetaFrameWinFarmObject = 1
Const cForReading = 1, cForWriting = 2
Const xlLeft = -4131
Const xlRight = -4152
Const cLightPurple = 16764108
Const cWhite = 2
intCellColor = cLightPurple
Dim oExcel, oGroup, oMember, oSelection
Dim strScriptFullName, strScriptPath, strSaveName, strTemp
Dim theFarm, anApp, aWinApp, anUser, anGroup
Dim intAppUserCount, intTotalAppUsers, intTotalFarmUsers, intCurRow, intCellColor
Dim arrTotalFarmUsers()
'
'Create the Excel document
'
Set oExcel = createobject("Excel.application")
oExcel.Visible = True
oExcel.Workbooks.Add
'
'Set up basic scripting objects
'
strScriptFullName = WScript.ScriptFullName
strScriptPath = Left(strScriptFullName, InStrRev(strScriptFullName, "\"))
'
' Create MetaFrameFarm object
'
Set theFarm = CreateObject("MetaFrameCOM.MetaFrameFarm")
if Err.Number <> 0 Then
WScript.Echo "Can't create MetaFrameFarm object"
WScript.Echo "(" & Err.Number & ") " & Err.Description
WScript.Echo ""
CloseOpenObjects
WScript.Quit Err.Number
End if
'
' Initialize the farm object.
'
theFarm.Initialize(cMetaFrameWinFarmObject)
if Err.Number <> 0 Then
WScript.Echo "Can't Initialize MetaFrameFarm object"
WScript.Echo "(" & Err.Number & ") " & Err.Description
WScript.Echo ""
CloseOpenObjects
WScript.Quit Err.Number
End if
'
' Are you Citrix Administrator?
'
If theFarm.WinFarmObject.IsCitrixAdministrator = 0 then
WScript.Echo "You must be a Citrix admin to run this script"
WScript.Echo ""
CloseOpenObjects
WScript.Quit 0
End If
'
' Setup the look, header, etc.
'
oExcel.Range("A1:A1").ColumnWidth = 55
oExcel.Range("B1:B1").ColumnWidth = 25
oExcel.Range("C1:C1").ColumnWidth = 6
oExcel.Range ("A1:A1").Font.Size = 16
oExcel.Range("A1:A3").Font.Bold = True
oExcel.Range("A1:C1").Interior.Color = vbBlack
oExcel.Range("A1:A1").Font.ColorIndex = cWhite
oExcel.Range ("A2:A6").Font.ColorIndex = 5
oExcel.Range("A1:A6").HorizontalAlignment = xlLeft
oExcel.Range("A7:C7").Font.Bold = True
oExcel.Range("A7:C7").Interior.Color = vbBlack
oExcel.Range("A7:C7").Font.ColorIndex = cWhite
wscript.echo "Citrix Farm Potential Users Report"
oExcel.Cells(1, 1).Value = "Citrix Farm Potential Users Report"
WScript.Echo "MetaFrame Farm Name: " & theFarm.FarmName & vbCRLF
oExcel.Cells(2, 1).Value = theFarm.FarmName & " Farm"
strTemp = Date() & " " & Time()
oExcel.Cells(3, 1).Value = strTemp
oExcel.Cells(7,1) = "App's Distinguished Name"
oExcel.Cells(7,2) = "Application Name"
oExcel.Cells(7,3) = "Users"
oExcel.Cells(5, 2).Value = "Total # of unique users with access to at least one app:"
oExcel.Range("B5:C5").Font.Bold = True
oExcel.Range("B5:B5").HorizontalAlignment = xlRight
'
'Loop through all applications in the farm
'
intCurRow = 7
For Each anApp In theFarm.Applications
ProcessApp (anApp)
Next
oExcel.Cells(5, 3).Value = intTotalFarmUsers
CloseOpenObjects
' ---------------------------------------------------------------
'
' END OF MAIN SCRIPT
'
' ---------------------------------------------------------------
' ---------------------------------------------------------------
Sub ProcessApp(ByRef CurrentApp)
Dim arrAppUsers()
if Err.Number <> 0 Then
WScript.Echo "Error enumerating applications"
WScript.Echo "(" & Err.Number & ") " & Err.Description
WScript.Echo ""
CloseOpenObjects
WScript.Quit Err.Number
End if
intCurRow = intCurRow + 1
if intCellColor = vbWhite then
intCellColor = cLightPurple
else
intCellColor = vbWhite
end if
oExcel.Cells(intCurRow, 1).Value = CurrentApp.DistinguishedName
oExcel.Cells(intCurRow, 2).Value = CurrentApp.AppName
'
' Count users granted access to the published app
'
For Each anUser In CurrentApp.Users
'
' MetaFrameUser object.
'
AddUserToAppArray anUser.UserName, arrAppUsers
AddUserToTotalArray anUser.UserName
Next
'
' For each group that the app is published to, get each group
' member (no processing of nested groups, if any), and add the
' user to the list of app users
'
For Each anGroup In CurrentApp.Groups
If Not (anGroup.GroupName = "*CITRIX_ADMINISTRATORS*") then
wscript.echo " - Processing group-->" & anGroup.AAName & "\" & anGroup.GroupName
Set oGroup = GetObject("WinNT://" & anGroup.AAName & "/" & anGroup.GroupName & ",group")
For Each oMember in oGroup.Members
AddUserToAppArray oMember.Name, ArrAppUsers
AddUserToTotalArray oMember.Name
Next
End If
Next
On Error Resume Next
intTotalAppUsers = uBound(arrAppUsers) ' returns a 9 if the array has no dimension
if err.number = 9 then
intTotalAppUsers = 0
On Error Goto 0
end if
On Error Resume Next
intTotalFarmUsers = uBound(arrTotalFarmUsers) ' returns a 9 if the array has no dimension
if err.number = 9 then
intTotalFarmUsers = 0
On Error Goto 0
end if
oExcel.Cells(intCurRow, 3).Value = intTotalAppUsers
oExcel.Cells(intCurRow, 1).Interior.Color = intCellColor
oExcel.Cells(intCurRow, 2).Interior.Color = intCellColor
oExcel.Cells(intCurRow, 3).Interior.Color = intCellColor
wscript.echo "App: " & anApp.AppName & " = " & intTotalAppUsers & " users"
wscript.echo "TOTAL FARM USERS SO FAR = " & intTotalFarmUsers
End Sub
' ---------------------------------------------------------------
Sub AddUserToTotalArray (ByVal strUserToTest)
Dim x, blnFound, intArrSize, intCount
x = 0
'wscript.echo " --Testing user for addition to total user list: " & strUserToTest
blnFound = False
On Error Resume Next
intArrSize = uBound(arrTotalFarmUsers) ' returns a 9 if the array has no dimension
if err.number = 9 then
wscript.echo " * Adding user " & strUserToTest & " to total users array (first user)"
ReDim Preserve arrTotalFarmUsers(1)
arrTotalFarmUsers(0) = strUserToTest
On Error Goto 0
Exit Sub
end if
On Error Goto 0
While (blnFound = False) and (x
if uCase(arrTotalFarmUsers(x)) = uCase(strUserToTest) then
blnFound = True
end if
x = x + 1
Wend
if blnFound = False then
wscript.echo " * Adding user " & strUserToTest & " to total users array"
ReDim Preserve arrTotalFarmUsers(intArrSize + 1)
arrTotalFarmUsers(uBound(arrTotalFarmUsers)-1) = strUserToTest
end if
End Sub
' ---------------------------------------------------------------
Sub AddUserToAppArray (ByRef strUserToTest,ByRef arrToTest)
Dim x, blnFound, intArrSize, intCount
x = 0
'wscript.echo " --Testing user for addition to app user list: " & strUserToTest
blnFound = False
On Error Resume Next
intArrSize = uBound(arrToTest) ' returns a 9 if the array has no dimension
if err.number = 9 then
'wscript.echo " * Adding user " & strUserToTest & " to array (first user)"
ReDim Preserve arrToTest(1)
arrToTest(0) = strUserToTest
On Error Goto 0
Exit Sub
end if
On Error Goto 0
While (blnFound = False) and (x
if uCase(arrToTest(x)) = uCase(strUserToTest) then
blnFound = True
end if
x = x + 1
Wend
if blnFound = False then
'wscript.echo " * Adding user " & strUserToTest & " to array"
ReDim Preserve arrToTest(intArrSize + 1)
arrToTest(uBound(arrToTest)-1) = strUserToTest
end if
End Sub
' ---------------------------------------------------------------
Sub CloseOpenObjects
'
'Save the doc, quit Excel and clean up variables
'
strSaveName = strScriptPath & CreateLogFileName & " - " & theFarm.FarmName & " Potential Users Report.xls"
oExcel.ActiveWorkbook.SaveAs(strSaveName)
oExcel.Quit
Set oExcel = Nothing
End Sub
' ---------------------------------------------------------------
Function CreateLogFileName
Dim strLogFileName
Dim strTemp
strLogFileName = DatePart("yyyy", Now) ' Year
strTemp = DatePart("m", Now) ' Month
If cint(strTemp)
strTemp = "0" & strTemp
End If
strLogFileName = strLogFileName & "-" & strTemp
strTemp = DatePart("d", Now) ' Day
If cint(strTemp)
strTemp = "0" & strTemp
End If
strLogFileName = strLogFileName & "-" & strTemp
strTemp = DatePart("h", Now) ' Hour
If cint(strTemp)
strTemp = "0" & strTemp
End If
strLogFileName = strLogFileName & " " & strTemp
strTemp = DatePart("n", Now) ' Minute
If cint(strTemp)
strTemp = "0" & strTemp
End If
strLogFileName = strLogFileName & strTemp
CreateLogFileName = strLogFileName
End Function
(Note: You must be logged in to post a comment.)
If you log in and nothing happens, delete your cookies from BrianMadden.com and try again. Sorry about that, but we had to make a one-time change to the cookie path when we migrated web servers.