VBScript to find Citrix Connection Disconnection timeout settings

' This script has been tested in Citrix PS4.0 environment

On Error Resume next
Const reading =1
Const HKEY_LOCAL_MACHINE = &H80000002
Set StdOut = WScript.StdOut

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Add
Set objWorksheet = objExcel.Worksheets(1)
objexcel.Visible = True
objexcel.DisplayAlerts = false

objworksheet.cells(1,1) = "ServerName"
objworksheet.cells(1,2) = "User Connection[Mins]"
objworksheet.cells(1,3) = "User Disconnection[Mins]"
objworksheet.cells(1,4) = "User Idle Timeout[Mins]"
objworksheet.cells(1,5) = "Broken or Timeout session"
objworksheet.cells(1,6) = "Reconnect Status"
objworksheet.cells(1,7) = "Shadowing"
objworksheet.cells(1,8) = "Encryption Level"

objworksheet.range("A1:H1").font.size=10
objworksheet.range("A1:H1").font.bold= True
objworksheet.range("A1:H1").interior.colorindex= 33

objexcel.Columns.Borders.ColorIndex=56


Set objFS= CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.OpenTextFile("C:\servers.txt", reading)

x=2

Do

strComputer= objFile.ReadLine
objworksheet.cells(x,1) = strcomputer

Set oReg= GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")


strKeyPath = "SYSTEM\CurrentControlSet\Control\Terminal Server\WinStations\ICA-tcp"


'---------------------------------------------------------------------------------
'Checking for Connection, Disconnection, Idle Timeout Settings
'---------------------------------------------------------------------------------
strfInheritMaxSessiontime = "fInheritMaxSessionTime"
strConnectionTime = "MaxConnectionTime"

strfInheritMaxDisconnectionTime = "fInheritMaxDisconnectionTime"
strDisconnectionTime = "MaxDisconnectionTime"

strfInheritMaxIdleTime = "fInheritMaxIdleTime"
strIdletimeout = "MaxIdleTime"


oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strfInheritMaxSessiontime,dwValueCon1
oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strConnectionTime,dwValueCon

oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strfInheritMaxDisconnectionTime,dwValueDiscon1
oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strDisconnectionTime,dwValueDiscon

oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strfInheritMaxIdleTime,dwValueIdle1
oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strIdletimeout,dwValueIdle

'
strValIdle=dwValueIdle/60000
strValDiscon=dwValueDiscon/60000
strValCon=dwValueCon/60000


If dwValueCon1 = 1 Then
   objworksheet.cells(x,2) = "Inherit connection set"
 ElseIf strValCon = 0 Then
   objworksheet.cells(x,2) = "No Connection Timeout"
   Else
   objworksheet.cells(x,2) = strValCon
End If

Set strValCon = Nothing
Set strValCon1 = Nothing


If dwValueDiscon1 = 1 Then
   objworksheet.cells(x,3) = "Inherit Disconnection set"
 elseIf strValDiscon = 0 Then
   objworksheet.cells(x,3) = "No Disconnection Timeout"
   Else
   objworksheet.cells(x,3) = strValDiscon
End If

Set strValueDiscon1 = Nothing
Set strValDiscon = Nothing

If dwValueIdle1 = 1 Then
   objworksheet.cells(x,4) = "Inherit Idle Timeout set"
 ElseIf strValIdle = 0 Then
   objworksheet.cells(x,4) = "No Idle Timeout"
   Else
   objworksheet.cells(x,4) = strValIdle
End If

Set strValueIdle1 = Nothing
Set strValIdle = Nothing
'-------------------------------------------------------------------------------------
'Checking for broken or timeout connection
'-------------------------------------------------------------------------------------

strInheritResetBroken = "fInheritResetBroken"
strResetBroken = "fResetBroken"

oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strInheritResetBroken,dwValueRbroken1
oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strResetBroken,dwValueRbroken

If dwValueRbroken1 = 1 Then
   objworksheet.cells(x,5) = "Inherit User Config"
 ElseIf dwValueRbroken = 0 Then
   objworksheet.cells(x,5) = "Disconnect"
 Else
   objworksheet.cells(x,5) = "Reset"
End If

Set dwValueRbroken1 = Nothing
Set dwValueRbroken = Nothing
'-------------------------------------------------------------------------------------
'Checking for Reconnect connection
'-------------------------------------------------------------------------------------

strInheritReconnectSame = "fInheritReconnectSame"
strReconnectSame = "fReconnectSame"

oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strInheritReconnectSame,dwValueRSame1
oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strReconnectSame,dwValueRSame

If dwValueRSame1 = 1 Then
   objworksheet.cells(x,6) = "Inherit User Config"
 ElseIf dwValueRSame = 0 Then
   objworksheet.cells(x,6) = "From any client"
 Else
   objworksheet.cells(x,6) = "From this client only"
End If

Set dwValueRSame1 = Nothing
Set dwValueRSame = Nothing
'-------------------------------------------------------------------------------------
'Checking for Shadowing connection
'-------------------------------------------------------------------------------------

strInheritShadow = "fInheritShadow"
strShadow = "Shadow"

oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strInheritShadow,dwValueShadow1
oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strShadow,dwValueShadow

If dwValueShadow1 = 1 Then
   objworksheet.cells(x,7) = "Inherit User Config"
 ElseIf dwValueShadow = 0 Then
   objworksheet.cells(x,7) = "Disabled"
 ElseIf dwValueShadow = 1 Then
   objworksheet.cells(x,7) = "Input ON, Notify ON"
 ElseIf dwValueShadow = 2 Then
   objworksheet.cells(x,7) = "Input ON, Notify OFF"
 ElseIf dwValueShadow = 3 Then
   objworksheet.cells(x,7) = "Input OFF, Notify ON"
 ElseIf dwValueShadow = 4 Then
   objworksheet.cells(x,7) = "Input OFF, Notify OFF"
End If

Set dwValueShadow1 = Nothing
Set dwValueShadow = Nothing
'-------------------------------------------------------------------------------------
'Checking for Emcryption Level
'-------------------------------------------------------------------------------------

strMinEncryptionLevel = "MinEncryptionLevel"

oReg.GetDWORDvalue HKEY_LOCAL_MACHINE,strKeyPath,strMinEncryptionLevel,dwValueEncrp


If dwValueEncrp = 0 Then
   objworksheet.cells(x,8) = "None"
 ElseIf dwValueEncrp = 1 Then
   objworksheet.cells(x,8) = "Basic"
 ElseIf dwValueEncrp = 10 Then
   objworksheet.cells(x,8) = "RC5[128-bit]Login only"
 ElseIf dwValueEncrp = 20 Then
   objworksheet.cells(x,8) = "RC5[40-bit]"
 ElseIf dwValueEncrp = 30 Then
   objworksheet.cells(x,8) = "RC5[56-bit]"
 ElseIf dwValueEncrp = 40 Then
   objworksheet.cells(x,8) = "RC5[128-bit]"
End If

Set dwValueEncrp = Nothing

'-------------------------------------------------------------------------------------

x= x+1
Loop Until objFile.AtEndOfStream =true

objworksheet.columns.autofit()

objworkbook.SaveAs "C:\Citrix_Connection_Settings.xls"

Set objworkbook = Nothing
Set objworksheet = Nothing
Set objfile = Nothing

WScript.Echo "File has been saved in C:\Citrix_Connection_Settings.xls"


***Share your comments about the post***

No comments:

Post a Comment