Pages

04 June 2013

Find and reset disconnected RDP Sessions

We have a lot of servers. When I get disconnected, I may leave hanging sessions on those servers which I forget to properly close. Then, after I change the password for my admin account, I sometimes get locked out as a result of what I had open in the now disconnected session.

Tracking this down is always annoying and time consuming.
When users (including administrators) are terminated, you want to find and reset those sessions too. 

ServerSessions.vbs is a script for admins to run to track down sessions on servers and optionally reset them. You can list sessions on all servers in a domain, and reset either all or just disconnected sessions

The script in VBS:

'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


Source

No comments:

Post a Comment