' -----------------------------------------------------------------------------
' PURPOSE:  List who is logged on to what machine in the domain
'   Determines current domain, then iterates all machines in the domain and who
'   is logged to each machine.  Servers with multiple login sessions will list
'   all the sessions.
'
' OPTIONAL PARAMETER: [-c ComputerName]  to list who is logged on to a single computer
'
' DISCLAIMER:  This script is intended for reference only.  Just because this worked
'   for me, you must assume that this script will probably turn your computer into a
'   puddle of molten silicon, or render your system inoperable requiring a full re-install.
'   I can not be held liable for damage done to your system by using any of this script.
' DEVELOPED BY: Jay Ohman, Ohman Automation Corp. - www.OhmanCorp.com
' -----------------------------------------------------------------------------
' On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
ReDim xServerList(1)
ReDim xCompList(10)
xDCDomainName = GetDomainContext()

set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
xCurFolder = "\C$\Program Files\"                     ' path to quick verify computer is on-line

Set oArgs = WScript.Arguments
If oArgs.Count => 1 Then                              '--- Process switches
  If oArgs(0) = "-c" Then
    strComputer = oArgs(1)
'    xComputerNameArg = "'" & oArgs(1) & "'"
    GetInfo(strComputer)
  Else
    xComputerNameArg = ""
    WScript.Echo "invalid argument, usage: cscript WhoLoggedOn.vbs [-c ComputerName]"
    WScript.Quit
  End If
Else
  GetDomainComps()
  For y = 0 To UBound(xCompList)
    If xCompList(y) <> "" Then
      aVal = Split(xCompList(y), ",")
      xComputer = Trim(aVal(0))
      If CBool(aVal(1)) Then
        GetInfo(xComputer)
      Else
        WScript.Echo "Machine  " & xComputer & Space(14 - Len(xComputer)) & " >>no connection<<"
      End If
    End If
  Next
End If

' -----------------------------------------------------------------------------
Function GetInfo(xComputer)
On Error Resume Next
  WScript.StdOut.Write "Checking " & xComputer & " ........" & VbCr
  If (fso.FolderExists( "\\" & xComputer & xCurFolder )) Then
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & xComputer & "\root\cimv2")
    If Err.Number <> 0 Then
      xStr = "pings, but: error (" & Err.Number & ") " & Err.Description
      ' WScript.Echo Err.Number & ", " & Err.Description & " XX"
      Err.Clear
    Else
      xStr = ""
    End If
    set objEnum = objWMIService.execQuery ("select __relpath from win32_process where caption = 'explorer.exe'")
    If xStr <> "" Then
      WScript.Echo "Checking " & xComputer & Space(14 - Len(xComputer)) & " " & xStr
    ElseIf objEnum.Count = 0 Then
      WScript.Echo "Checking " & xComputer & Space(14 - Len(xComputer)) & " (no logons)"
    Else
      x = 0
      For Each obj in objEnum
        Set outParams = obj.ExecMethod_("GetOwner")
        If x = 0 Then
          WScript.Echo "Checking " & xComputer & Space(14 - Len(xComputer)) & "User: " & outParams.User
        Else
          WScript.Echo Space(23) & "User: " & outParams.User
        End If
        x = x + 1
      Next
    End If
  Else
    WScript.Echo "Checking " & xComputer & Space(14 - Len(xComputer)) & " >>no connection<<"
  End If
End Function

'----------------------------------------------------------------------------------
' go get the domain name naming context of the current domain
'----------------------------------------------------------------------------------
Function GetDomainContext()
  Dim objRootDSE
  Set objRootDSE = GetObject("LDAP://rootDSE")
  GetDomainContext = objRootDSE.Get("defaultNamingContext")
End Function
' -----------------------------------------------------------------------------
Sub GetDomainComps()
  Set objConnection = CreateObject("ADODB.Connection")
  Set objCommand = CreateObject("ADODB.Command")

  '----------------------------------------------------------------------------------
  ' go fetch the list of Domain Controllers from Active Directory
  '----------------------------------------------------------------------------------
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
  Set objCommand.ActiveConnection = objConnection
  objCommand.CommandText = "SELECT distinguishedName from " & _
      "'LDAP://cn=Configuration," & xDCDomainName & "' " & "WHERE objectClass='nTDSDSA'"
  objCommand.Properties("Page Size") = 1000
  objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
  Set objRecordSet = objCommand.Execute
  objRecordSet.MoveFirst
  y = 0
  Do Until objRecordSet.EOF
    xServerName=Split(objRecordSet.Fields("distinguishedName").Value, ",")
    xServerList(y) = Replace(xServerName(1), "CN=", "")
    ' Wscript.Echo "Domain Controller: " & Replace(xServerName(1), "CN=", "")
    objRecordSet.MoveNext
    y = y + 1
    If (UBound(xServerList) < y) Then ReDim Preserve xServerList(y)
  Loop


  '----------------------------------------------------------------------------------
  ' go get the list of all computers from Active Directory
  '----------------------------------------------------------------------------------
  Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
  xDomainName = Replace( Replace(xDCDomainName, "DC=", "" ) , ",", ".")
  ' WScript.Echo "Testing all computers found in AD domain: " & Replace( Replace(xDCDomainName, "DC=", "" ) , ",", ".")
  objCommand.CommandText = "Select Name from 'LDAP://" & xDCDomainName & "' " & _
      "Where objectClass='computer' Order By Name"
  Set objRecordSet = objCommand.Execute
  objRecordSet.MoveFirst
  y = 0 : xStr = "."
  Do Until objRecordSet.EOF
    xIsDC = FALSE
    xCurComputer = objRecordSet.Fields("Name").Value
    ' ----------- check for DC
    For x = 0 To UBound(xServerList)
      If xServerList(x) = xCurComputer Then xIsDC = TRUE
    Next
    If xIsDC Then xDCStr = TRUE Else xDCStr = FALSE
    ' ----------- see if the computer is reachable
    Set colPings = objWMIService.ExecQuery ("SELECT * FROM Win32_PingStatus WHERE Address = '" & xCurComputer & "'")
    For Each objPing in colPings
      If (objPing.StatusCode = 0) Then xPinged = TRUE Else xPinged = FALSE
    Next
    xCompList(y) = xCurComputer & "," & xPinged & "," & xDCStr
    ' WScript.Echo xCompList(y)
    WScript.StdOut.Write "Loading domain " & xDomainName & ": " & xStr & VbCr
    xStr = xStr & "."
    y = y + 1
    objRecordSet.MoveNext
    If (UBound(xCompList) < y) Then ReDim Preserve xCompList(y)
  Loop
  WScript.Echo ""
  WScript.Echo "...  done, " & y & " ComputerNames loaded from AD" & VbCrLf
  WScript.Echo "Checking for logins..."
End Sub