' NAME: TopComputerUsers.vbs
'
' AUTHOR:  alan dot kaplan at VA dot Gov 
' DATE  : 1/31/2012, 2/3/12
'
' COMMENT: This script identifies the top 5 interactive users for a computer. 
' It is useful to figure out who the primary user is for a computer, and the last logon time for that user
' v 1.1 adds copy to clipboard , cleaned up code a bit.
'==========================================================================

Option Explicit

Dim WshShell:Set WshShell = WScript.CreateObject("WScript.Shell")
Dim message
Dim strCurrUser, strComputer 
Dim oWMI, oRS
Dim colCS, oComputer 
Dim colLogons, oLogon
Dim strFullName 
Dim i:i=0 

'ref http://www.devguru.com/Technologies/ado/quickref/record_fieldscollection.html
Const adVarChar = 200
Const MaxCharacters = 255
Const adFldIsNullable = 32
Const adInteger = 3
Const adDBTimeStamp = 135 'YYYYMMDDHHMMSS date/time format 

If WScript.Arguments.Count = 1 Then
	strComputer = WScript.Arguments(0)
Else
	message = "This script identifies the top 5 interactive users for a computer. This can take a while on a system with many users. " & _
	"Find the top domain users for what computer:"
	strComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
	strComputer = InputBox(message,"Computer Name?",strComputer)
End If 

If strcomputer = "" Then WScript.Quit
strComputer = UCase(strComputer)

On Error Resume Next 
Set oWMI = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
If Err <> 0 Then
	MsgBox "Failed to connect to " & strComputer & ". " & Err.Description,vbCritical + vbOKOnly,"Fatal Error"
	WScript.Quit
End If 

Set colCS = oWMI.ExecQuery("Select Username from Win32_ComputerSystem")
If Err <> 0 Then
	MsgBox "Failed to connect to " & strComputer & ". " & Err.Description,vbCritical + vbOKOnly,"Fatal Error"
	WScript.Quit
End If 

For Each oComputer in colCS
    strCurrUser = oComputer.UserName 
    Exit For 
Next

If isNull(strCurrUser) Then strCurrUser = "(No console user now)"
message = "Current user:	" & strCurrUser & VbCrLf & String(25,"=") & VbCrLf & _
	 VbCrLf & "Top 5 Users:" & VbCrLf &  String(25,"=") & VbCrLf 

'create disconnected recordset -- note the ADOR
Set oRS = CreateObject("ADOR.Recordset")
oRS.Fields.Append "FullName", adVarChar, MaxCharacters, adFldIsNullable
oRS.Fields.Append "LogonName", adVarChar, MaxCharacters, adFldIsNullable
oRS.Fields.Append "LastLogon", adVarChar, adFldIsNullable
oRS.Fields.Append "NumberofLogons", adInteger, adFldIsNullable
oRS.Open

On Error Resume Next
Set colLogons = oWMI.ExecQuery("SELECT Fullname,LastLogon,Name,NumberOfLogons FROM Win32_NetworkLoginProfile where numberofLogons > 0",,48)

For Each oLogon In colLogons
    oRS.AddNew
    oRS("FullName") = oLogon.FullName
    oRS("LogonName") = oLogon.Name
    oRS("LastLogon") = WMI2LocalTime(ologon.Lastlogon) 
    oRS("NumberofLogons") = oLogon.NumberOfLogons
    oRS.Update
Next


oRS.Sort = "NumberOfLogons DESC"
oRS.MoveFirst
Do Until oRS.EOF Or i = 5
	strFullName =  oRS.Fields.Item("FullName")
	If Len(strFullName) > 1 Then 
		strFullName = "(" & strFullName & ")"
	Else
		strFullName = ""
	End If 
	
    message = message & oRS.Fields.Item("LogonName") & Space(1) & strFullName & vbNewLine & vbTab & _
    	 "Total Logons: " &  oRS.Fields.Item("NumberOfLogons") & ", last: " & oRS.Fields.Item("LastLogon")& VbCrLf 
    i = i + 1
oRS.MoveNext
Loop

oRS.Close

Dim retVal 
retval = MsgBox(message & VbCrLf & VbCrLf & "Copy results to clipboard?",vbQuestion + vbYesNo,"Interactive Users of " & strComputer)
If retval = vbYes Then 
	message = strComputer & " user information:" & VbCrLf & VbCrLf & message 
	message = Replace(message,vbNewLine & vbTab ,", ")
	Copy2Clip(message)
End If 
' =========== Functions and Subs =============

Function WMI2LocalTime(strWMITime)
	Dim DateTime
	Const CONVERT_TO_LOCAL_TIME = True
	' Create a new datetime object.
	Set dateTime = CreateObject("WbemScripting.SWbemDateTime")
	'Set Value
	dateTime.Value = strWMITime
	'Return localtime VT_DATE format.
	WMI2LocalTime = dateTime.GetVarDate(CONVERT_TO_LOCAL_TIME)
	Set dateTime = Nothing
End Function 

Function Copy2Clip(strMessage)
	Dim objWord
 	'Sets what you want to put in the clipboard using Word object
	'Variation of code by Tony Bothwell, posted at
	'http://stackoverflow.com/questions/128463/use-clipboard-from-vbscript
	
	' Declare an object for the word application  
	On Error Resume Next
	Set objWord = CreateObject("Word.Application")
	If Err = 0 Then 
		' Using the object
		With objWord    
			.Visible = False             	' Don't show Word
			.Documents.Add               	' Create a document
			.Selection.TypeText strMessage	' Put text into it    
			.Selection.WholeStory        	' Select everything in the doc
			.Selection.Copy              	' Copy contents to clipboard    
			.Quit False                  	' Close Word, don't save
		End With
		WshShell.Popup "Data copied to clipboard",15,"Done"
	Else
		Err.Clear
		If(MsgBox ("Could not copy to clipboard, send to notepad instead?",_
			vbYesNo + vbQuestion, "Send to Notepad") = vbYes) then
			wshshell.Run("notepad.exe")
			
			While wshshell.appactivate("Untitled - Notepad") = False
				Wscript.Sleep 10
			Wend
			
			wshshell.SendKeys strMessage
		End If 
	End If 
	On Error GoTo 0
End Function