Every so often I’ll end up with a disconnected RDP session somewhere which causes chaos come password reset day; locking my account out etc. I came across the following script over at http://www.akaplan.com/blog/ which will search for RDP/RDS sessions on every server in a domain for a particular user. Run using cscript.exe serversessions.vbs. Click Read More for the script.
{code lang:ini showtitle:false lines:false hidden:false}’ServerSessions.vbs
‘Lists and optionally resets a user’s server sessions
‘Alan dot Kaplan at VA dot Gov.
’10/24/2011. 10/26 version fixed logging when list only
Option Explicit
dim wshShell
Set wshShell = WScript.CreateObject(“WScript.Shell”)
Dim retval
Const ADS_CHASE_REFERRALS_ALWAYS = &H20
Dim oConn, oCmd, oRS
Dim strADSPath, strADOQuery
Dim strDomainCN
Dim fso,logfile, appendout
Dim strUser, strSessionID
‘Get the default ADsPath for the domain to search.
Dim root: Set root = GetObject(“LDAP://rootDSE”)
strADSPath = root.Get(“defaultNamingContext”)
Const ForAppend = 8
Set fso = CreateObject(“Scripting.FileSystemObject”)
If (Not IsCScript()) Then ‘If not CScript, re-run with cscript…
dim quote
quote=chr(34)
WshShell.Run “CScript.exe ” & quote & WScript.ScriptFullName & quote, 1, true
WScript.Quit ‘…and stop running as WScript
End If
If InStr(1,MyOS,”Server”,1) = 0 Then
MsgBox “You must run this from server OS”,vbExclamation + vbOKOnly,”Error”
‘WScript.Quit
End If
retval = MsgBox(“This script will identify and optionally logoff disconnected sessions for a user on all of the servers ” & _
“in AD within a domain. Do you want to continue?”,vbYesNo + vbQuestion,”Get List of all Servers”)
If retval = vbNo Then WScript.Quit
strADSPath = InputBox(“Get server list from what domain”,”Domain”,strADSPath)
If strADSPath = “” Then WScript.Quit
strUser = InputBox(“Search for what username?”,”User Name”,wshShell.ExpandEnvironmentStrings(“%USERNAME%”))
If strUser = “” Then WScript.Quit
dim message
message = “Do you want to:” & VbCrLf & _
“1) Get list only” & VbCrLf & _
“2) Reset disconnected sessions” & VbCrLf & _
“3) Reset all sessions for user” & VbCrLf & _
“0) Quit”
Dim iActionType
iActionType = InputBox(message,”Choose Action”,1)
iActionType = CDbl(iActionType)
If iActionType = 0 Then WScript.Quit
GetServerList
wshShell.Run “notepad.exe ” & quote & logfile & quote
‘ =========== Functions and Subs ==========
Sub GetServerList()
‘— Set up the connection —
Set oConn = CreateObject(“ADODB.Connection”)
Set oCmd = CReateObject(“ADODB.Command”)
oConn.Provider = “ADsDSOObject”
oConn.Open “ADs Provider”
Set oCmd.ActiveConnection = oConn
oCmd.Properties(“Page Size”) = 50
ocmd.Properties(“Chase referrals”) = ADS_CHASE_REFERRALS_ALWAYS
logfile = Replace(strADSPath,”,”,”_”)
logfile = Replace(logfile,”DC=”,””)
logfile = wshShell.ExpandEnvironmentStrings(“%userprofile%”) & “\desktop\” & strUser & ” In ” & logfile & “.txt”
If fso.FileExists(logfile) Then fso.DeleteFile logfile,True
set AppendOut = fso.OpenTextFile(logfile, ForAppend, True)
strDomainCN = DomainCN(strADSPath)
‘— Build the query string —
strADOQuery = “<LDAP://” & strDomainCN & “/” & strADSPath & “>;” & “(&(OperatingSystem=*Server*)(objectClass=computer))” & “;” & _
“Name;subtree”
oCmd.CommandText = strADOQuery
‘— Execute the query for the object in the directory —
Set oRS = oCmd.Execute
If oRS.EOF and oRS.Bof Then
MsgBox “No Servers AD entries found!”,vbCritical + vbOKOnly,”Failed”
appendout.WriteLine “Query Failed”
Else
While Not oRS.Eof
SessionQuery oRS.Fields(“Name”)
oRS.MoveNext
Wend
End If
oRS.Close
oConn.Close
End Sub
Sub SessionQuery (strServer)
WScript.Echo “Checking ” & strServer
dim objEx, data
Set objEx = WshShell.Exec(“QWinsta /server:” & strServer)
‘one line at a time
While Not (objEx.StdOut.AtEndOfStream)
data = objEx.StdOut.ReadLine
If InStr(1,data,strUser,1) Then
strSessionID = GetSession(data)
if iactionType = 1 then
EchoAndLog strServer & “,found session for ” & strServer
Else
Wscript.echo strServer & “,found session for ” & strServer
End if
‘always logoff
If iActionType = 3 Then ResetSession strServer, strSessionID
‘Logoff disconnected
If iActionType =2 And InStr(1,data,”disc”,1) Then
ResetSession strServer,strSessionID
End If
End If
Wend
End Sub
Sub ResetSession(strServer, ID)
Dim strCommand, oExec
strCommand = “reset session ” & id & ” /server:” & strServer
Set oExec = WshShell.Exec(strCommand)
wscript.sleep 500
‘this is typically empty
While Not (oExec.StdOut.AtEndOfStream)
EchoAndLog oExec.StdOut.ReadLine
Wend
If oExec.ExitCode <> 0 Then
EchoAndLog strServer & “,Problem resetting session ” & ID & ” on server ” & strServer & “, Non-zero exit code, ” & oExec.exitcode
Else
EchoAndLog strServer & “,Reset session ” & ID & ” on server ” & strServer
End If
End Sub
Function DomainCN(strPath)
DomainCN = Replace(strPath,”,”,”.”)
DomainCN= Replace(DomainCN,”DC=”,””)
End Function
Function MyOS()
Dim oWMI,ColOS,ObjOS, OSver
Set oWMI = GetObject(“winmgmts:\\.\root\cimv2”)
Set ColOS = oWMI.ExecQuery(“SELECT Caption, version FROM Win32_OperatingSystem”)
For Each ObjOS In ColOS
MyOS = objOS.caption & Space(1) & objos.version
Next
End Function
Function GetSession(text)
text = strip(lcase(Text))
Dim tArray, i
tArray = Split(text,Space(1))
i = 0
While tArray(i) <> lCase(strUser)
i = i +1
Wend
GetSession = tArray(i+1)
End Function
Function Strip(text)
text = Replace(text,vbtab,Space(1))
While InStr(text,Space(2)) > 0
text = replace(text,Space(2),Space(1))
Wend
Strip = text
End Function
Sub EchoAndLog (message)
‘Echo output and write to log
Wscript.Echo message
AppendOut.WriteLine message
End Sub
Function IsCScript()
If (InStr(UCase(WScript.FullName), “CSCRIPT”) <> 0) Then
IsCScript = True
Else
IsCScript = False
End If
End Function
{/code}