Logged on or not logged on? That is the domain question.

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Logged on or not logged on? That is the domain question.

Logged in as: Guest

arrSession:exec spGetSession 2,16,57988

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Logged on or not logged on? That is the domain question.
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Logged on or not logged on? That is the domain question. - 3/16/2008 10:06:53 PM

TomRiddle

Posts: 90
Score: 0
Joined: 2/7/2008
Status: offline

You would think that there would be an easier way of doing this!

Here is my best attempt.
The only other way I could think of was a little logon and logoff script on every computer, deployed by grouppolicy that saves back to a database.

This script determines the exact times that a user in the domain last logged on and off.
Effectively script will report if a user is currently logged onto the domain.

' Script by TomRiddle 2008
' LoggedOnStatus.vbs

' Determine exact times a user in the domain last logged on and off.
' Effectively script will report if a user is currently logged onto the domain.

' Tested on Windows 2003 domain controllers ok. 
' User must have roaming profile path set to get the logged off date.

Option Explicit

Dim objRootDSE, strConfig, adoConnection, adoCommand, strQuery
   Dim adoRecordset, objDC
   Dim strDNSDomain, objShell, lngBiasKey, lngBias, k, arrstrDCs()
   Dim strDN, dtmDate, objDate, objList, strUser
   Dim strBase, strFilter, strAttributes, lngHigh, lngLow

Dim strUserID
   Dim objConnection, objCommand, objRecordSet, DistinguishedADPath
   Dim objUser
   Dim objFSO, objFile
   Dim strLogOnDate, strLogOffDate

strUserID=inputbox("Enter UserID to report lastlogon", "LoggedOnStatus.vbs")

' Use a dictionary object to track latest lastLogon for each user.
   Set objList = CreateObject("Scripting.Dictionary")
   objList.CompareMode = vbTextCompare

' Obtain local Time Zone bias from machine registry.
   Set objShell = CreateObject("Wscript.Shell")
   lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
       & "TimeZoneInformation\ActiveTimeBias")
   If (UCase(TypeName(lngBiasKey)) = "LONG") Then
       lngBias = lngBiasKey
   ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
       lngBias = 0
       For k = 0 To UBound(lngBiasKey)
           lngBias = lngBias + (lngBiasKey(k) * 256^k)
       Next
   End If

' Determine configuration context and DNS domain from RootDSE object.
   Set objRootDSE = GetObject("LDAP://RootDSE")
   strConfig = objRootDSE.Get("configurationNamingContext")
   strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory for ObjectClass nTDSDSA.
' This will identify all Domain Controllers.
   Set adoCommand = CreateObject("ADODB.Command")
   Set adoConnection = CreateObject("ADODB.Connection")
   adoConnection.Provider = "ADsDSOObject"
   adoConnection.Open "Active Directory Provider"
   adoCommand.ActiveConnection = adoConnection

strBase = "<LDAP://" & strConfig & ">"
   strFilter = "(objectClass=nTDSDSA)"
   strAttributes = "AdsPath"
   strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

adoCommand.CommandText = strQuery
   adoCommand.Properties("Page Size") = 100
   adoCommand.Properties("Timeout") = 60
   adoCommand.Properties("Cache Results") = False

Set adoRecordset = adoCommand.Execute

' Enumerate parent objects of class nTDSDSA. Save Domain Controller
' AdsPaths in dynamic array arrstrDCs.
   k = 0
   Do Until adoRecordset.EOF
       Set objDC = _
           GetObject(GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
       ReDim Preserve arrstrDCs(k)
       arrstrDCs(k) = objDC.DNSHostName
       k = k + 1
       adoRecordset.MoveNext
   Loop
   adoRecordset.Close

' Get Distinguished AD Path of user
   On Error Resume Next
   Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
   Set objCommand =   CreateObject("ADODB.Command")
   objConnection.Provider = "ADsDSOObject"
   objConnection.Open "Active Directory Provider"
   Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 1000
   objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

objCommand.CommandText = _
       "SELECT distinguishedName FROM 'LDAP://"& strDNSDomain &"' WHERE objectCategory='user' " & _
           "AND sAMAccountName='"& strUserID &"'"
   Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst

Do Until objRecordSet.EOF
      DistinguishedADPath=objRecordSet.Fields("distinguishedName").Value
      objRecordSet.MoveNext
   Loop

On Error Goto 0

if DistinguishedADPath = "" then
      msgbox "Invalid UserID Entered" &vbcrlf& "Quitting"
      wscript.quit
   end if

' Retrieve lastLogon attribute for user on EACH Domain Controller.
   For k = 0 To Ubound(arrstrDCs)
       strBase = "<LDAP://" & arrstrDCs(k) & "/" & DistinguishedADPath & ">"
       strFilter = "(&(objectCategory=person)(objectClass=user))"
       strAttributes = "distinguishedName,lastLogon"
       strQuery = strBase & ";" & strFilter & ";" & strAttributes

adoCommand.CommandText = strQuery
       On Error Resume Next
       Set adoRecordset = adoCommand.Execute

If (Err.Number <> 0) Then
           On Error GoTo 0
           msgbox "Domain Controller not available: " & arrstrDCs(k)
       Else
           On Error GoTo 0
           Do Until adoRecordset.EOF
               strDN = adoRecordset.Fields("distinguishedName").Value
               On Error Resume Next
               Set objDate = adoRecordset.Fields("lastLogon").Value
               If (Err.Number <> 0) Then
                  On Error GoTo 0
                  dtmDate = #1/1/1601#
               Else
                  On Error GoTo 0
                  lngHigh = objDate.HighPart
                  lngLow = objDate.LowPart
                  If (lngLow < 0) Then
                     lngHigh = lngHigh + 1
                  End If
                  If (lngHigh = 0) And (lngLow = 0 ) Then
                     dtmDate = #1/1/1601#
                  Else
                     dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
                         + lngLow)/600000000 - lngBias)/1440
                  End If
               End If
               If (objList.Exists(strDN) = True) Then
                  If (dtmDate > objList(strDN)) Then
                     objList.Item(strDN) = dtmDate
                  End If
               Else
                  objList.Add strDN, dtmDate
               End If
               adoRecordset.MoveNext
           Loop
           adoRecordset.Close
       End If
   Next

' Read last Logon date for user.
   For Each strUser In objList.Keys
      if instr(objList.Item(strUser), "/1601") then
         strLogOnDate = "Never"
      else
         strLogOnDate = objList.Item(strUser)
      end if
   Next

' Read last Logout date for user
   On Error Resume Next

Set objUser = GetObject ("LDAP://" & DistinguishedADPath)
   Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FolderExists(objUser.ProfilePath) Then
      Set objFile = objFSO.GetFile(objUser.ProfilePath&"\ntuser.dat")
      strLogOffDate = objFile.DateLastModified
   Else
      strLogOffDate = "Never"
   End If
   on error goto 0

' Report Results
   if strLogonDate = "Never" then 
      msgbox "No record of user ever logging on"
      wscript.quit
   end if

if strLogOffDate = "Never" then
      msgbox "User logged on "&strLogonDate&vbcrlf&"User probably does not have a roaming profile"&vbcrlf&"Therefore logged off status can not be determined"
      wscript.quit
   end if

if strLogOffDate > strLogonDate then 
      msgbox "User "&strUserID& " last logged in "&strLogonDate&vbcrlf&"And last logged off " & strLogOffDate
      wscript.quit
   elseif strLogOffDate < strLogonDate then 
      msgbox "User "&strUserID& " logged in " & strLogOnDate &vbcrlf&"And appears to be still logged in"
      wscript.quit
   else
      msgbox "Can not determine User "&strUserID& "'s logged in or logged out status???"
      wscript.quit
   end if

' Clean up.
   adoConnection.Close
   Set objRootDSE = Nothing
   Set adoConnection = Nothing
   Set adoCommand = Nothing
   Set adoRecordset = Nothing
   Set objDC = Nothing
   Set objDate = Nothing
   Set objList = Nothing
   Set objShell = Nothing
   set objUser = Nothing
   set objFSO = Nothing
   set objFile = Nothing