'This one is a good example of my Hack Projects
'I walked into a Domain that had a lot of cobwebs, in terms of undeleted/un-disabled user accounts
'Most of these user accounts belong to people that had left the company as far back as 5 mergers
'So, we are going to find these OLD accounts, and if they have email accounts, we'll get the email addresses
'and use the output to send them test emails asking them to respond

'The send email part is not a part of this script
'I have since written a better script for this purpose. Like I said, this one was a hurried Hack
'But I will post it anyway. I like the idea of keeping old stuffs around.

' PwdLastSet.vbs
' Modified and adapted by Deji Akomolafe - April 8, 2003
' VBScript program to determine when each user in the domain last logged
' on.
'
' ----------------------------------------------------------------------
' Copyright (c) 2002 Richard L. Mueller
' Version 1.0 - December 7, 2002
' Version 1.1 - January 17, 2003 - Account for null value for LastLogon.
' Version 1.2 - January 23, 2003 - Account for DC not available.
' Version 1.3 - February 3, 2003 - Retrieve users but not contacts.
' Version 1.4 - February 19, 2003 - Standardize Hungarian notation.
' Version 1.5 - March 11, 2003 - Remove SearchScope property.
'
' Because the LastLogon attribute is not replicated, every Domain
' Controller in the domain must be queried to find the latest LastLogon
' date for each user. The lastest date found is kept in a dictionary
' object. The program first uses ADO to search the domain for all Domain
' Controllers. The AdsPath of each Domain Controller is saved in an
' array. Then, for each Domain Controller, ADO is used to search the
' copy of Active Directory on that Domain Controller for all user
' objects and return the LastLogon attribute. The LastLogon attribute is
' a 64-bit number representing the number of 100 nanosecond intervals
' since 12:00 am January 1, 1601. This value is converted to a date. The
' last logon date is in UTC (Coordinated Univeral Time). It must be
' adjusted by the Time Zone bias in the machine registry to convert to
' local time.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.

'Option Explicit
Const ADS_SCOPE_SUBTREE = 2
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const FILEPATH = "c:\LastLogin\"	'This is Path where we will write the output file

'We will use FSO to create the Output file.
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSOWrite=FSO.OpenTextFile(FILEPATH & "LastLogon_Email.xls", 8, True)
FSOWrite.WriteLine "FullName" & vbTab & "Last Login Date" & vbTab & "Email Address" & vbTab & "AD Location"
FSOWrite.Close

Dim objRootDSE, strConfig, objConnection, objCommand, strQuery
Dim objRecordSet, objDC
Dim strDNSDomain, objShell, lngBiasKey, lngBias, k, arrstrDCs()
Dim strDN, dtmDate, objDate, lngDate, objList, strUser, joinStrOU, strUser1, strName, strDisName, LoginName, emailaddress
Dim strBase, strFilter, strAttributes

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

Set objEmail = CreateObject("Scripting.Dictionary")
objEmail.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")

'For situations where there are multiple Domains in the Forest, and
'We want to query a domain that is different from our Local Domain
'We can directly specify the Domain, e.g.
'strDNSDomain = "dc=childDomain,dc=rootDomainname,DC=TLD(e.g. com or net or local)"

'Wscript.Echo strConfig & vbTab & strDNSDomain
'Wscript.Quit

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

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

Wscript.Echo vbCRLf & strQuery
'Wscript.Quit
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 60
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute

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

' Retrieve LastLogon attribute for each user on each Domain Controller.
For k = 0 To Ubound(arrstrDCs)
  strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
  strFilter = "(&(ObjectCategory=person)(ObjectClass=user))"
  strAttributes = "samAccountName,DisplayName,DistinguishedName,LastLogon"
  strQuery = strBase & ";" & strFilter & ";" & strAttributes _
    & ";subtree"
	'Wscript.Echo strQuery
  objCommand.CommandText = strQuery
  On Error Resume Next
  Err.Clear
  Set objRecordSet = objCommand.Execute
  If Err.Number <> 0 Then
    Err.Clear
    On Error GoTo 0
    Wscript.Echo "Domain Controller not available: " & arrstrDCs(k)
  Else
    On Error GoTo 0
    Do Until objRecordSet.EOF
      strDN = objRecordSet.Fields("DistinguishedName")
      lngDate = objRecordSet.Fields("LastLogon")

      On Error Resume Next
      Err.Clear
      Set objDate = lngDate
      If Err.Number <> 0 Then
        Err.Clear
        dtmDate = #1/1/1601#
      Else
        If (objDate.HighPart = 0) And (objDate.LowPart = 0 ) Then
          dtmDate = #1/1/1601#
        Else
          dtmDate = #1/1/1601# + (((objDate.HighPart * (2 ^ 32)) _
            + objDate.LowPart)/600000000 - lngBias)/1440
        End If
      End If
      On Error GoTo 0
      If objList.Exists(strDN) Then
        If dtmDate > objList(strDN) Then
          objList(strDN) = dtmDate
        End If
      Else
        objList.Add strDN, dtmDate
        'objList.Add strLoginName, strDisName
      End If
      objRecordSet.MoveNext
    Loop
  End If
Next

' Output latest LastLogon date for each user.
For Each strUser1 In objList
	strUser = UCASE(strUser1)
	'Wscript.Echo strUser
	'Wscript.quit(0)
	'There are some account that are intentionally configured with the "password never expires" option
	'These accounts are all in the "SERVICEACCOUNTS" OU
	'We also have a "TERMINATED" OU for terminated users whose account have not been deleted, only disabled.
	'We don't want to get anything for these type of accounts, so we exempt them from the output

	If instr(strUser, "TERMINATED") > 0 Then
	ElseIf instr(strUser, "SERVICEACCOUNTS") > 0 Then
	Else
	'We are splitting and Joining here just to get a well-formatted output
	strDisName = Split(strUser, ",")
	strName = strDisName(0)
	strName = Replace(strName, "CN=","")
	pwdAge = objList(strUser)
	joinStrOU = Replace(strDisName(3) & "/" & strDisName(2) & "/" & strDisName(1), "OU=", "")
	joinStrOU = Replace(joinStrOU, "CN=", "")
	joinStrOU = Replace(joinStrOU, "DC=", "")
	
	'OK, now call the Sub that looks for the user's email address
  	Call FindEmail(strName, joinStrOU, pwdAge)
	'Wscript.Echo strLoginName & vbTab & objList(strUser) & vbTab & joinStrOU
	End If
Next

' Clean up.
Set objRootDSE = Nothing
Set objConnection = Nothing
Set objCommand = Nothing
Set objRecordSet = Nothing
Set objDC = Nothing
Set objDate = Nothing
Set objList = Nothing
Set objShell = Nothing



'"""""""""""""""""""""""
'Find Email Addy
'We are doing this so that we can get the email addresses of the old users
'We can then send them emails asking if they are still alive or not
'This part is optional.

Sub FindEmail(strName, joinStrOU, pwdAge)

Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSOWrite=FSO.OpenTextFile(FILEPATH & "LastLogon_Email.xls", 8, True)

'On Error Resume Next
Wscript.Echo strName
If instr(strName, "'") > 0 Then
Wscript.Echo "Found Double Quotes"
strName = Replace(strName, "'", "''")
End If
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = _
    "Select Name,mail from 'GC://nameofaGC.myDomainname.com/dc=DC=myDomainName,DC=com' " _
        & "WHERE objectCategory='Person' AND Name = '" & strName & "'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30 
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
objCommand.Properties("Cache Results") = False 
Set objRecordSet = objCommand.Execute

'On Error Resume Next
objRecordSet.MoveFirst

Do Until objRecordSet.EOF

		objusermail = objRecordSet.Fields("mail").Value
		If objUsermail = "" Then
		objUsermail = "Not Mail-Enabled"
		End If
		If instr(strName, "''") > 0 Then
		strName = Replace(strName, "''", "'")
		End If
		FSOWrite.WriteLine strName & vbTab & pwdAge & vbTab & objusermail & vbTab & joinStrOU

objRecordSet.MoveNext
Loop
FSOWrite.Close
set FSOWrite=Nothing
set FSO=Nothing
Set objCOmmand.ActiveConnection = Nothing
Set objCommand = Nothing
Set objRecordSet = Nothing
Set objConnection = Nothing

End Sub