'Alan dot Kaplan at va dot gov
'original 7-22-04 for VA VISN 6
'1-5-05 revised to allow partial list
'3-5-2009 Revised to take into account that DCs are not 
'always where you expect.  Also added authentication server, copy to clipboard.
'9-8-2010 Fixed problem with error handling where query fails, fixed query other domains

Option explicit 
dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")
Dim lngbias
Dim dLastLogon, dLastLogoff, strFirst, strLast
Dim strNTName
Dim objEnv
Dim Sdomain, root, strComputer
Dim objConn, objCommand
Dim message, strDCList, retval
Dim DCs, controller, strDCName, strLastLogonServer
Dim strDomain


If (Not IsCScript()) Then 		'If not CScript, re-run with cscript...
	dim quote, strArgs, i
	quote=chr(34)
	
	For i  = WScript.Arguments.Count -1 to  0 Step -1
		strArgs = WScript.Arguments(i) & Space(1) &  straArgs
	Next
	
	WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote & space(1) & strArgs, 1, true
    WScript.Quit            	'...and stop running as WScript
End If

Const ADS_SCOPE_SUBTREE = 2
Set objEnv = WshShell.Environment("process")
strNTName = ucase(objEnv("UserName"))
dLastLogon =  #1/1/1601# ' never logged on
dLastLogoff =  #1/1/1601# ' never logged off

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

'Get the ADsPath for the domain to search. 
Set root = GetObject("LDAP://rootDSE")
Sdomain = root.Get("defaultNamingContext") 'current domain

If WScript.Arguments.Count = 1 Then
	strNTName = WScript.Arguments(0)
Else
	strNTName = InputBox ("This checks the last logon authentication event for a user.  " & _
	 " Check the last logon (or unlock) information for what NT Username:","Enter NT Name",strNTName)
End If 

If strNTName = "" Then WScript.Quit

'Commented out for ADHealth

Sdomain = InputBox ("Check what domain?","Domain Path",Sdomain)
If Sdomain = "" Then WScript.Quit


retval = MsgBox("Query all DCs in " & Sdomain & "?",vbYesNoCancel,"Which DCs?")
If retval = vbCancel Then WScript.Quit

GetZone

If retval = vbYes  Then 
	QueryDCs
Else
	QueryList
End If 

If dLastLogon = #1/1/1601#  Then 
message = "No record found for last logoff of " & strFirst & Space (1) & strLast &  " (" & _
	strNTName & ") from within " & strDomain& ". (VPN and other domains not searched)" 
Else
	message = strFirst & Space (1) & strLast &  " (" & _
	strNTName & ") last logged onto or unlocked a system from within " & strDomain & " on " & _
	dLastLogon & ", and was authenticated by " & strLastLogonServer & "." & VbCrLf &  "(VPN and other domains not searched)" 
End If 

retval =MsgBox(message& VbCrLf & VbCrLf & "Copy this to your clipboard using IE?",_
	vbinformation + vbyesno,"Last Logon for " & strNTName)

If retval = vbYes Then
	Dim objIE
	Set objIE = CreateObject("InternetExplorer.Application")
	objIE.Navigate("about:blank")
	objIE.document.parentwindow.clipboardData.SetData "text", message
	objIE.Quit
End If 


'========= Subs and Functions =================
Sub QueryDCs()
	Dim strQuery, objDC
	Dim rs
	strDomain = OUCN(Sdomain)

	' Construct the LDAP query that will find all the domain controllers in the domain
	strQuery = "<LDAP://" & Root.Get("ConfigurationNamingContext") & _
		">;((objectClass=nTDSDSA));ADsPath;subtree"

	objCommand.CommandText = strQuery
	objCommand.Properties("Page Size") = 1000
	Set rs = objCommand.Execute
	
	Do While Not rs.eof 
		' Bind to the domain controller computer object
		' (This is the parent object of the result from the query)
		Set objDC = getobject(getobject(rs(0)).Parent)
	
		If instr(1,objDC.dNSHostName,strDomain,1) Then 
			strDCName = objDC.cn
			WScript.Echo "Querying " & strDCName
			LastLogon strDCName, strNTName
		End If 
	    rs.MoveNext
	Loop
End Sub

Sub QueryList()
	Dim aDCs
	strDCList = InputBox ("Enter names of DCs, separated by commas","List",strDCList)
	If strDCList = "" Then WScript.Quit
	
 	aDCs = Split(strDCList,",")
 
	For Each strDCName In aDCs 
		WScript.Echo "Querying " & strDCName
		LastLogon strDCName, strNTName
	Next
End Sub

Sub LastLogon (servername, NTName)
	On Error Resume Next 
	Dim strQuery, dLastLogonServer, dLastLogoffServer
	Dim RS
	strQuery =  "SELECT samAccountName, givenname, sn, lastlogon FROM " & _
	    "'LDAP://" & servername & "' WHERE samAccountName = '" & strNTName &  "'"
	'WScript.Echo strQuery
	objCommand.CommandText = strQuery
	objCommand.Properties("SearchScope") = ADS_SCOPE_SUBTREE
	Set RS = objCommand.Execute
	
	if Err.Number <> 0 Then 
		WScript.Echo vbtab & "Error querying " & servername & ": " &  Err.Description
		Exit Sub
	End If 
		
	If RS.EOF And RS.BOF Then
		MsgBox strNTName & " not found!", vbcritical + vbokonly, "Error"
	    WScript.Quit
	End If 
	
	dLastLogonServer = integer8Date(RS("LastLogon").value,lngbias)

	Wscript.echo servername, dLastLogonServer 

	If dLastLogonServer > dLastLogon Then 
		dLastLogon = dLastLogonServer
		strLastLogonServer = servername
	End If 
	
	strFirst = RS("GivenName")
	strLast = RS("sn")
	On Error goto 0
End Sub 


Function OUCN(strADSPath)
	Dim oRS, tArray
	objCommand.CommandText = _
	"SELECT CanonicalName FROM 'GC://"& strADSPath &"' WHERE objectClass='organizationalUnit'"  
	Set oRS = objCommand.Execute
	oRS.MoveFirst
	If IsArray(oRS.fields("canonicalName").value) Then 
		tArray = oRS.fields("canonicalName").value
		OUCN = tArray(0)
	 Else
	 	OUCN = oRS.fields("canonicalName").value
	 End If 
	If InStr(ouCN,"/") Then 
		tArray = Split(OUCN,"/")
		OUCN = tArray(0)
	End If 
End Function 


Sub GetZone()
	'R Muller's code
	' Obtain local time zone bias from machine registry.
	'need this for integer8date below
	Dim lngBiasKey
	lngBiasKey = wshShell.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
End Sub 

Function Integer8Date(objDate, lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
' http://www.rlmueller.net/Integer8Attributes.htm
  Dim lngAdjust, lngDate, lngHigh, lngLow
  
  If IsNull(objDate) Then 
	 	Integer8Date = #1/1/1901#
	    Exit Function
  End If
  
  lngAdjust = lngBias
  lngHigh = objDate.HighPart
  lngLow = objdate.LowPart
' Account for error in IADslargeInteger property methods.
  If lngLow < 0 Then
    lngHigh = lngHigh + 1
  End If
  If (lngHigh = 0) And (lngLow = 0) Then
    lngAdjust = 0
  End If
  lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
    + lngLow) / 600000000 - lngAdjust) / 1440
    
' Trap error if lngDate is ridiculously huge.
  On Error Resume Next
  Integer8Date = CDate(lngDate)
  If Err.Number <> 0 Then
    On Error GoTo 0
    Integer8Date = #1/1/1601#
  End If
  
  On Error GoTo 0
End Function

Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function