See all users and computers that they are logged into - real time What this is, is a silent logon script and a silent logoff script that you apply via grouppolicy to all users and a GUI to monitor what is going on.
UserID, Time, and Workstation details are saved to a database on a server.
When you want to see what computer(s) a particular user is logged into, you open the HTA script (the GUI) with three pages
1. A page with a list of all computers logged on, the user and date/time
2. A page with a list of all computers logged off and last username, date/time
3. A page listing all users logged into more than one computer.
The HTA will auto refresh every 30 seconds, you can manually refresh it sooner too.
The last 20 users also get their full name displayed via an AD look up. The full name part was an after thought and I should have added the full name to the database rather than do an Active Directory lookup which kind of kills it when you have many users. Hence the limit.
You don't need to muck around making databases, this script will make the database, you just provide a server path where all users have write access to.
Tips
Use CTL + F to search for a UserID or computer name, The list can get really long, sorry I thought this was good enough.
Results may be strange until the database is fully populated by every machine logging on and then off.
If you have problems with database you could just delete it and next computer logging back on again will recreate it.
Save the three scripts below with the following names. LogonDatabase.vbs LogoffDatabase.vbs logonoff.hta
Lastly, search for remarks in the script surrounded with *** Astrix's **** and change to reflect your network.
I have removed my server and domain details, and replaced with generic entries, like domain.com
I have had this running in a production network with 1000+ computers for several months problem free, so vouch for it's robustness. I think it is a very powerful tool that increases network admin productivity. I hope you find it useful or at least interesting.
LogonDatabase.vbs
'Script by tomriddle 2009
'LogONOFF Database
'Apply this script as a logon script to all domain users.
'Script will save workstation name, user name and time to server database.
'Script quits if operating system is Server
'Check OS version and quit if OS is Server
On Error Resume Next
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
strComputer="."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
'x=inputbox(objItem.Caption, objItem.Caption, objItem.Caption)
If InStr(1,objItem.Caption,"Server") Then
wscript.Quit
end if
next
on error goto 0
'Update DataBase with Details
on error resume next
'*********************Change this path to where you want your database***************************************
DBPath="\\server\share\LogonOffDatabase\LogONOFF.mdb"
DBCreate
DatabaseUpdate ComputerName, UserLoggedIn, strNow
on error goto 0
WScript.Quit
'---------------------------------------
Function DBCreate
'Create Database Function
'Check if database exists
Set objFSOA = CreateObject("Scripting.FileSystemObject")
If objFSOA.FileExists(DBPath) Then
exit function
Else
'Create Database
Set objConnectionA = CreateObject("ADOX.Catalog")
objConnectionA.Create _
"Provider = Microsoft.Jet.OLEDB.4.0; " & _
"Data Source = "&DBPath
'Create table
Set objConnectionA = CreateObject("ADODB.Connection")
objConnectionA.Open _
"Provider= Microsoft.Jet.OLEDB.4.0; " & _
"Data Source= "&DBPath
objConnectionA.Execute "CREATE TABLE LogONOFFTable(MachineName TEXT(50) ,UserName TEXT(50) ,DateOn TEXT(50) ,LastUserName TEXT(50) ,LastDateON TEXT(50) ,LastDateOFF TEXT(50))"
objConnectionA.Close
End if
End Function
'---------------------------------------
Function DatabaseUpdate(strComputer, UserName, strDate)
'Write to database function
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
Set objConnectionx = CreateObject("ADODB.Connection")
Set objRecordSetx = CreateObject("ADODB.Recordset")
'Check if machine has been added to database already
objConnectionx.Open _
"Provider = Microsoft.Jet.OLEDB.4.0; " & _
"Data Source = "&DBPath
objRecordSetx.Open "SELECT LogONOFFTable.MachineName FROM LogONOFFTable WHERE (((LogONOFFTable.MachineName)="&Chr(34)&strComputer&Chr(34)&"))", _
objConnectionx, adOpenStatic, adLockOptimistic
On Error Resume NEXT
objRecordSetx.MoveFirst
If objRecordsetx.Fields.Item("MachineName")="" Then
On Error Goto 0
objRecordSetx.Close
'Add machine to database along with it's status (new entry)
on error resume next
objRecordSetx.Open "SELECT * FROM LogONOFFTable" , _
objConnectionx, adOpenStatic, adLockOptimistic
objRecordSetx.AddNew
objRecordSetx("MachineName") = strComputer
objRecordSetx("UserName") = UserName
objRecordSetx("DateOn") = strDate
objRecordSetx("LastUserName") = UserName
objRecordSetx("LastDateON") = strDate
objRecordSetx("LastDateOFF") = ""
objRecordSetx.Update
on error goto 0
Else
'Machine is already in the database update entries to avoid duplicates
On Error Goto 0
objRecordSetx.Close
on error resume next
objConnectionx.Execute "update LogONOFFTable" _
& " set UserName = '" & UserName & "'" _
& " where MachineName = '" & StrComputer & "'"
objConnectionx.Execute "update LogONOFFTable" _
& " set DateOn = '" & strDate & "'" _
& " where MachineName = '" & StrComputer & "'"
on error goto 0
End IF
objConnectionx.Close
End Function
'---------------------------------------------------
Function UserLoggedIn
'Display logged on user
on error resume next
Set objNetwork = CreateObject("WScript.Network")
UserLoggedIn = objNetwork.UserName
if err<>0 then UserLoggedIn="Err"
on error goto 0
End Function
'---------------------------------------------------
Function ComputerName
'This computer's name
On Error Resume Next
Set objNet = CreateObject("WScript.NetWork")
ComputerName = objNet.ComputerName
if err<>0 then ComputerName="Err"
on error goto 0
end function
'---------------------------------------------------
Function strNow
'My now function
on error resume next
if len(day(date))=2 then
strDay=day(date)
else
strDay=0&day(date)
end if
if len(month(date))=2 then
strmonth=month(date)
else
strmonth=0&month(date)
end if
if len(Hour(Now))=2 then
strHour=Hour(Now)
else
strHour=0&Hour(Now)
end if
if len(Minute(Now))=2 then
strMinute=Minute(Now)
else
strMinute=0&Minute(Now)
end if
if len(second(Now))=2 then
strSecond=second(Now)
else
strSecond=0&Second(Now)
end if
strYear=mid(year(date), 3, 2)
strNow=CStr(strYear&"/"&strMonth&"/"&strDay&"-"&strHour&":"&strMinute&":"&strSecond)
on error goto 0
End Function
'---------------------------------------------------
LogoffDatabase.vbs
'Script by tomriddle 2009
'LogONOFF Database
'Apply this script as a logOff script to all domain users.
'Script will save workstation name, user name and time to server database.
'Script quits if operating system is Server
'Check OS version and quit if machine in Server OU
set objNetwork = createobject("Wscript.Network")
strComputer=objNetwork.ComputerName
'*********************Change this to your domain name***************************************
strDomain = "domain"
'Constants required for name translate
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strDomain & "\" & strComputer & "$"
strComputerDN = objTrans.Get(ADS_NAME_TYPE_1779)
if instr(1, lcase(strComputerDN), lcase("Servers")) or instr(1, lcase(strComputerDN), lcase("Controllers")) then wscript.quit
'msgbox strComputerDN
'Update DataBase with Details
on error resume next
'*********************Change this path to where you want your database***************************************
DBPath="\\WS2003V\c$\LogONOFF.mdb"
DBCreate
DatabaseUpdate ComputerName, UserLoggedIn, strNow
on error goto 0
WScript.Quit
'---------------------------------------
Function DBCreate
'Create Database Function
'Check if database exists
Set objFSOA = CreateObject("Scripting.FileSystemObject")
If objFSOA.FileExists(DBPath) Then
exit function
Else
'Create Database
Set objConnectionA = CreateObject("ADOX.Catalog")
objConnectionA.Create _
"Provider = Microsoft.Jet.OLEDB.4.0; " & _
"Data Source = "&DBPath
'Create table
Set objConnectionA = CreateObject("ADODB.Connection")
objConnectionA.Open _
"Provider= Microsoft.Jet.OLEDB.4.0; " & _
"Data Source= "&DBPath
objConnectionA.Execute "CREATE TABLE LogONOFFTable(MachineName TEXT(50) ,UserName TEXT(50) ,DateOn TEXT(50) ,LastUserName TEXT(50) ,LastDateON TEXT(50) ,LastDateOFF TEXT(50))"
objConnectionA.Close
End if
End Function
'---------------------------------------
Function DatabaseUpdate(strComputer, UserName, strDate)
'Write to database function
UserNameOff=""
strDateOff=""
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
Set objConnectionx = CreateObject("ADODB.Connection")
Set objRecordSetx = CreateObject("ADODB.Recordset")
'Read previous info if exists so that it can be put into LastUserName and LastDateOFF fields
objConnectionx.Open _
"Provider = Microsoft.Jet.OLEDB.4.0; " & _
"Data Source = "&DBPath'
objRecordSetx.Open "SELECT * FROM LogONOFFTable", objConnectionx, adOpenStatic, adLockOptimistic
objRecordSetx.MoveFirst
Do Until objRecordSetx.EOF or TestMachineName=strComputer
TestMachineName= objRecordsetx.Fields.Item("MachineName")
if TestMachineName = strComputer then
DBUserName=objRecordsetx.Fields.Item("UserName")
DBDateOn=objRecordsetx.Fields.Item("DateOn")
end if
objRecordSetx.MoveNext
loop
objRecordSetx.Close
objConnectionx.Close
'Check if machine has been added to database already
objConnectionx.Open _
"Provider = Microsoft.Jet.OLEDB.4.0; " & _
"Data Source = "&DBPath
objRecordSetx.Open "SELECT LogONOFFTable.MachineName FROM LogONOFFTable WHERE (((LogONOFFTable.MachineName)="&Chr(34)&strComputer&Chr(34)&"))", _
objConnectionx, adOpenStatic, adLockOptimistic
On Error Resume NEXT
objRecordSetx.MoveFirst
If objRecordsetx.Fields.Item("MachineName")= "" Then
On Error Goto 0
objRecordSetx.Close
'Add machine to database along with it's status (new entry)
on error resume next
objRecordSetx.Open "SELECT * FROM LogONOFFTable" , _
objConnectionx, adOpenStatic, adLockOptimistic
objRecordSetx.AddNew
objRecordSetx("MachineName") = strComputer
objRecordSetx("UserName") = UserNameOff
objRecordSetx("DateOn") = strDateOff
objRecordSetx("LastUserName") = UserName
objRecordSetx("LastDateOFF") = strDate
objRecordSetx.Update
on error goto 0
Else
'Machine is already in the database update entries to avoid duplicates
On Error Goto 0
objRecordSetx.Close
on error resume next
objConnectionx.Execute "update LogONOFFTable" _
& " set UserName = '" & UserNameOff & "'" _
& " where MachineName = '" & StrComputer & "'"
objConnectionx.Execute "update LogONOFFTable" _
& " set DateOn = '" & strDateOff & "'" _
& " where MachineName = '" & StrComputer & "'"
if DBUserName = "" then
objConnectionx.Execute "update LogONOFFTable" _
& " set LastUserName = '" & UserName & "'" _
& " where MachineName = '" & StrComputer & "'"
objConnectionx.Execute "update LogONOFFTable" _
& " set LastDateON = '" & "???" & "'" _
& " where MachineName = '" & StrComputer & "'"
else
objConnectionx.Execute "update LogONOFFTable" _
& " set LastUserName = '" & DBUserName & "'" _
& " where MachineName = '" & StrComputer & "'"
objConnectionx.Execute "update LogONOFFTable" _
& " set LastDateON = '" & DBDateOn & "'" _
& " where MachineName = '" & StrComputer & "'"
end if
objConnectionx.Execute "update LogONOFFTable" _
& " set LastDateOFF = '" & strDate & "'" _
& " where MachineName = '" & StrComputer & "'"
on error goto 0
End IF
objConnectionx.Close
End Function
'---------------------------------------------------
Function UserLoggedIn
'Display logged on user
on error resume next
Set objNetwork = CreateObject("WScript.Network")
UserLoggedIn = objNetwork.UserName
if err<>0 then UserLoggedIn="Err"
on error goto 0
End Function
'---------------------------------------------------
Function ComputerName
'This computer's name
On Error Resume Next
Set objNet = CreateObject("WScript.NetWork")
ComputerName = objNet.ComputerName
if err<>0 then ComputerName="Err"
on error goto 0
end function
'---------------------------------------------------
Function strNow
'My now function
on error resume next
if len(day(date))=2 then
strDay=day(date)
else
strDay=0&day(date)
end if
if len(month(date))=2 then
strmonth=month(date)
else
strmonth=0&month(date)
end if
if len(Hour(Now))=2 then
strHour=Hour(Now)
else
strHour=0&Hour(Now)
end if
if len(Minute(Now))=2 then
strMinute=Minute(Now)
else
strMinute=0&Minute(Now)
end if
if len(second(Now))=2 then
strSecond=second(Now)
else
strSecond=0&Second(Now)
end if
strYear=mid(year(date), 3, 2)
strNow=CStr(strYear&"/"&strMonth&"/"&strDay&"-"&strHour&":"&strMinute&":"&strSecond)
on error goto 0
End Function
'---------------------------------------------------
logonoff.hta
<html>
<head>
<title>LogonOff Database</title>
<HTA:APPLICATION
ID="ObjLogonOffDatabase"
APPLICATIONNAME="LogonOffDatabase"
SCROLL="yes"
SINGLEINSTANCE="no"
>
<style>
body,td,a {font-family:Tahoma, Veranda, Arial; font-size:12px; text-decoration:none; color:black;}
a:link { color : blue; background : transparent ; text-decoration: underline}
a:visited { color : black; background : transparent ; text-decoration: none}
a:Hover { color : red; background : transparent ; text-decoration: none}
</style>
<SCRIPT Language="VBScript">
'---------------------------------------------------------
Sub Window_Onload
'Script by tomriddle 2009
'logon/logoff database
'Set initial page dimensions
window.resizeto 500, 800
RefreshMe
iTimerID = window.setInterval("RefreshMe", 30000)
End Sub
'---------------------------------------------------------
sub RefreshMe
if instr(DisplayHTML.innerhtml, "Machines Logged ON") >0 then
MachinesLoggedON
exit sub
end if
if instr(DisplayHTML.innerhtml, "Machines Logged OFF") >0 then
MachinesLoggedOFF
exit sub
end if
if instr(DisplayHTML.innerhtml, "Users Logged onto more than one Machine") >0 then
MultipleLogon
else
MachinesLoggedON
end if
End sub
'---------------------------------------------------------
Sub MachinesLoggedON
DisplayHTML.innerhtml=""
displayHead=""
display=""
Set MyConn = CreateObject("ADODB.Connection")
'*********************Change this to path to where you want your database***************************************
MdbFilePath = "\\server\share\LogonOffDatabase\LogONOFF.mdb"
MyConn.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & MdbFilePath & ";"
SQL_query = "SELECT LogONOFFTable.MachineName, LogONOFFTable.UserName, LogONOFFTable.DateOn "&_
"FROM LogONOFFTable "&_
"WHERE (((LogONOFFTable.UserName)<>'')) "&_
"ORDER BY LogONOFFTable.DateOn DESC;"
Set RS = MyConn.Execute(SQL_query)
WHILE NOT RS.EOF
count = count + 1
strMachineName = RS("MachineName")
strUserID = ucase(RS("UserName"))
if count <= 20 then
strUserName =FullName(strUserID)
else
strUserName ="AD Lookup Skipped"
end if
strDateOn = RS("DateOn")
if count mod 2 = 0 then
altcol="EBF3FF"
else
altcol="E3F0F2"
end if
display=display&"<tr><td bgcolor="&altcol&">"&strMachineName&"</td><td bgcolor="&altcol&">"&strUserID&"</td><td bgcolor="&altcol&">"&strUserName&"</td><td bgcolor="&altcol&">"&strDateOn&"</td></tr>"
RS.MoveNext
WEND
displayHead="<center><font color=red size=3><b>Machines Logged ON "&count&"</b></font></center><br><table border=0 bgcolor=ffffff><tr><td bgcolor=DDE0E3><font size=3><b>PC</td><td bgcolor=DDE0E3><font size=3><b>UserID</td><td bgcolor=DDE0E3><font size=3><b>UserName</td><td bgcolor=DDE0E3><font size=3><b>Date/Time On</td></tr>"
'DisplayHTML.innerhtml=""
DisplayHTML.innerhtml=displayHead&display&"</table>"
RS.Close
set RS = nothing
MyConn.close
set MyConn = nothing
end sub
'---------------------------------------------------------
Sub MachinesLoggedOFF
displayHead=""
display=""
Set MyConn = CreateObject("ADODB.Connection")
'*********************Change this to path to where you want your database***************************************
MdbFilePath = "\\server\share\LogonOffDatabase\LogONOFF.mdb"
MyConn.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & MdbFilePath & ";"
SQL_query = "SELECT LogONOFFTable.MachineName, LogONOFFTable.LastUserName, LogONOFFTable.LastDateOFF "&_
"FROM LogONOFFTable "&_
"WHERE (((LogONOFFTable.LastDateOFF)<>'') AND ((LogONOFFTable.UserName)='')) "&_
"ORDER BY LogONOFFTable.LastDateOFF DESC , LogONOFFTable.UserName DESC;"
Set RS = MyConn.Execute(SQL_query)
WHILE NOT RS.EOF
count = count + 1
strMachineName = RS("MachineName")
strUserID = ucase(RS("LastUserName"))
if count <= 20 then
strUserName =FullName(strUserID)
else
strUserName ="AD Lookup Skipped"
end if
strDateOFF = RS("LastDateOFF")
if count mod 2 = 0 then
altcol="EBF3FF"
else
altcol="E3F0F2"
end if
display=display&"<tr><td bgcolor="&altcol&">"&strMachineName&"</td><td bgcolor="&altcol&">"&strUserID&"</td><td bgcolor="&altcol&">"&strUserName&"</td><td bgcolor="&altcol&">"&strDateOff&"</td></tr>"
RS.MoveNext
WEND
displayHead="<center><font color=red size=3><b>Machines Logged OFF "&count&"</b></font></center><br><table border=0 bgcolor=ffffff><tr><td bgcolor=DDE0E3><font size=3><b>PC</td><td bgcolor=DDE0E3><font size=3><b>Last UserID</td><td bgcolor=DDE0E3><font size=3><b>UserName</td><td bgcolor=DDE0E3><font size=3><b>Date/Time Off</td></tr>"
'DisplayHTML.innerhtml=""
DisplayHTML.innerhtml=displayHead&display&"</table>"
RS.Close
set RS = nothing
MyConn.close
set MyConn = nothing
end sub
'---------------------------------------------------------
Sub MultipleLogon
Set MyConn = CreateObject("ADODB.Connection")
'*********************Change this to path to where you want your database***************************************
MdbFilePath = "\\server\share\LogonOffDatabase\LogONOFF.mdb"
MyConn.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & MdbFilePath & ";"
SQL_query = "SELECT LogONOFFTable.UserName, LogONOFFTable.MachineName, LogONOFFTable.DateOn "&_
"FROM LogONOFFTable "&_
"WHERE (((LogONOFFTable.UserName) In (SELECT [UserName] FROM [LogONOFFTable] As Tmp GROUP BY [UserName] HAVING Count(*)>1 ) And (LogONOFFTable.UserName)<>'')) "&_
"ORDER BY LogONOFFTable.UserName;"
Set RS = MyConn.Execute(SQL_query)
WHILE NOT RS.EOF
count = count + 1
strMachineName = RS("MachineName")
strUserID = ucase(RS("UserName"))
if count <= 20 then
strUserName =FullName(strUserID)
else
strUserName ="AD Lookup Skipped"
end if
strDateOn = RS("DateOn")
if count mod 2 = 0 then
altcol="EBF3FF"
else
altcol="E3F0F2"
end if
display=display&"<tr><td bgcolor="&altcol&">"&strMachineName&"</td><td bgcolor="&altcol&">"&strUserID&"</td><td bgcolor="&altcol&">"&strUserName&"</td><td bgcolor="&altcol&">"&strDateOn&"</td></tr>"
RS.MoveNext
WEND
displayHead="<center><font color=red size=3><b>Users Logged onto more than one Machine</b></font></center><br><table border=0 bgcolor=ffffff><tr><td bgcolor=DDE0E3><font size=3><b>PC</td><td bgcolor=DDE0E3><font size=3><b>UserID</td><td bgcolor=DDE0E3><font size=3><b>UserName</td><td bgcolor=DDE0E3><font size=3><b>Date/Time On</td></tr>"
'DisplayHTML.innerhtml=""
DisplayHTML.innerhtml=displayHead&display&"</table>"
RS.Close
set RS = nothing
MyConn.close
set MyConn = nothing
end sub
'---------------------------------------------------------
Function FullName(strUserID)
'Find distinguished name and AD path from supplied UserID
DistinguishedADPath =""
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
'*********************Change this to your domain name***************************************
objCommand.CommandText = _
"SELECT distinguishedName FROM 'LDAP://dc=domain,dc=com' 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
' Check if above script failed to find user account
If DistinguishedADPath ="" Then
FullName="Can't find userID in AD"
Exit Function
End if
Set objUser = GetObject ("LDAP://"&DistinguishedADPath)
FullName = objUser.displayName
if FullName = "" then FullName = "No Display name returned from AD"
on error goto 0
End Function
'---------------------------------------------------------
</script>
</head>
<body>
<DIV id="Main" STYLE="position:absolute">
<center>
<table border=1 cellpadding=5 style="filter:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#c0c0c0', startColorstr='#ffffff', gradientType='0');">
<tr>
<td>
<center><font face="Tahoma" color=Blue size=4><b> Domain Logon Database </b></font></center>
<br>
<center>
<table border=0 cellspacing=15>
<tr>
<td bgcolor=ffffff><input id=runbutton1 class="button" type="button" value="" name="run_button1" onClick="MachinesLoggedON" title="Machines Logged ON"><font size=3> Logged ON</td>
<td bgcolor=ffffff><input id=runbutton2 class="button" type="button" value="" name="run_button2" onClick="MachinesLoggedOFF" title="Machines Logged OFF"><font size=3> Logged OFF</td>
<td bgcolor=ffffff><input id=runbutton3 class="button" type="button" value="" name="run_button3" onClick="MultipleLogon" title="Multiple Logons"><font size=3> Multiple logons</td>
<tr>
</table>
</centre>
<br>
<span id=DisplayHTML></span>
</td>
</tr>
</table>
</center>
</Div>
</body>
</html>