Solved

Modify VB Script to show the number of failed logins since last successful login

Posted on 2008-10-01
14
1,022 Views
Last Modified: 2010-05-18
I have a script that RobSampson helped me with.  I need it modified to show the number of failed logins since the last successful login.  It currently shows the date and time of the last failed login.  I'm by no means skilled in VBscripting.  I was thinking it could be modified to write the failed logins to a text file to get the information.  The successful logins are currently written to a text file.  Any help is greatly appreciated.


Option Explicit
'On Error Resume Next
 
Dim WSHShell, WSHProcess, strUserName, strHostName, strCommand
 
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
 
Set WSHShell = CreateObject("Wscript.Shell")
Set WSHProcess = WSHShell.Environment("Process")
 
strUserName = WSHProcess("USERNAME")
strHostName = WSHProcess("COMPUTERNAME")
 
 
Dim objShell, strComputer, objWMIService, colComputerIP, IPConfig, intIPCount, strIPAddress, strFullIP
Dim  objFSO, objFile, strOutputFile
Dim strContents, arrLinesInFile, intLineCount, intMaxLinesAllowed, dteLastLogon
Dim objADSysInfo, objUser, dteLastFailedLogin
strComputer = "."
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
Set objShell = CreateObject("WScript.Shell")
 
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colComputerIP = objWMIService.ExecQuery _
    ("Select * from Win32_NetworkAdapterConfiguration")
 
For Each IPConfig in colComputerIP
      If Not IsNull(IPConfig.IPAddress) Then
        For intIPCount = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
                strIPAddress = strIPAddress & "IP Address: " & IPConfig.IPAddress(intIPCount) & "~"
            Next
      End If
Next
 
If InStr(strIPAddress, "192.168.20.") > 0 Then
      strFullIP = Mid(strIPAddress, InStr(strIPAddress, "192.168.20."), InStr(InStr(strIPAddress, "192.168.20."), strIPAddress, "~") - InStr(strIPAddress, "192.168.20."))
ElseIf InStr(strIPAddress, "192.168.30.") > 0 Then
      strFullIP = Mid(strIPAddress, InStr(strIPAddress, "192.168.30."), InStr(InStr(strIPAddress, "192.168.30."), strIPAddress, "~") - InStr(strIPAddress, "192.168.30."))
Else
      strFullIP = "UNKNOWN"
End If
 
If Len(strFullIP) > 1 And Right(strFullIP, 1) = "~" Then
      strFullIP = Left(strFullIP, Len(strFullIP) - 1)
End If
      
' /////// Define the text file name as the name of the user //////////
strOutputFile = "\\corpfs01\userLogins\" & strUserName & ".txt"
 
On Error Resume Next
 
'/////// Open the user's text file for reading first to be able to count the number of lines ///////
'Set objFile = objFSO.OpenTextFile ("\\corpfs01\UserLogins\" & strOutputFile, ForAppending, True)
Set objFile = objFSO.OpenTextFile (strOutputFile, ForReading, True)
 
'////// Set this value to the maximum number of entries allowed per user's text file
'////// Set this value to 0 or -1 to have unlimited lines
intMaxLinesAllowed = -1
 
strContents = ""
strContents = objFile.ReadAll
 
If Len(strContents) > 0 Then
      arrLinesInFile = Split(strContents, vbCrLf)
      dteLastLogon = Trim(Split(arrLinesInFile(0), "|")(2))
      dteLastFailedLogin = Get_Last_Failed_Login
      MsgBox "You last logged on at " & dteLastLogon & VbCrLf & "Your last failed logon was " & dteLastFailedLogin
      If intMaxLinesAllowed > 0 Then
            If UBound(arrLinesInFile) > (intMaxLinesAllowed - 1) Then
                  strContents = ""
                  For intLineCount = 0 To (intMaxLinesAllowed - 2)
                        strContents = strContents & arrLinesInFile(intLineCount) & VbCrLf
                  Next
                  strContents = strContents & arrLinesInFile((intMaxLinesAllowed - 1))
            End If
      End If
End If
 
'MsgBox "There are " & UBound(arrLinesInFile) & " lines in the file before adding 1."
 
Set objFile = objFSO.OpenTextFile (strOutputFile, ForWriting, True)
objFile.Write(Pad_String(strFullIP, 20, "Right", " ") & "|  " & Pad_String(strHostName, 24, "Right", " ") & "|  " & Now & VbCrLf & strContents)
 
objFile.Close
 
On Error Goto 0
 
 
'*************************************************************
 
Function Pad_String(strOriginalString, intTotalLengthRequired, strPaddingSide, strCharacterToPadWith)
	If LCase(strPaddingSide) <> "left" And LCase(strPaddingSide) <> "right" Then
		strPaddingSide = "right"
	End If
	Select Case LCase(strPaddingSide)
		Case "left" 
			Pad_String = Right(String(intTotalLengthRequired, Left(strCharacterToPadWith, 1)) & strOriginalString, intTotalLengthRequired)
		Case "right" 
			Pad_String = Left(strOriginalString & String(intTotalLengthRequired, Left(strCharacterToPadWith, 1)), intTotalLengthRequired)
	End Select
End Function
 
Function Get_Last_Failed_Login
	Dim objShell
	Dim objRootDSE, strConfig, adoConnection, adoCommand, strQuery
	Dim adoRecordset, objDC
	Dim objADSysInfo, strUserDN
	'Dim objShell
	Dim strOU, strDNSDomain, lngBiasKey, lngBias, k, arrstrDCs()
	Dim strDN, dtmDate, objDate, objList, strUser
	Dim strBase, strFilter, strAttributes, lngHigh, lngLow, strAllDCs, objUser
	 
	' Use a dictionary object to track latest lastLogon for each user.
	Set objList = CreateObject("Scripting.Dictionary")
	objList.CompareMode = vbTextCompare
	 
	Set objADSysInfo = CreateObject("ADSystemInfo")
	strUserDN = objADSysInfo.UserName
	 
	' 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.
	 
	Dim strDetails
	 
	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
	 
	' Retrieve lastLogon attribute for each user on each Domain Controller.
	strAllDCs = "All Domain Controller data:"
	For k = 0 To Ubound(arrstrDCs)
	    strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
	    strFilter = "(&(objectCategory=person)(objectClass=user)(distinguishedName=" & strUserDN & "))"
	    strAttributes = "distinguishedName"
	    strQuery = strBase & ";" & strFilter & ";" & strAttributes _
	        & ";subtree"
	    adoCommand.CommandText = strQuery
	    On Error Resume Next
	    Set adoRecordset = adoCommand.Execute
	    If (Err.Number <> 0) Then
	        On Error GoTo 0
	        Wscript.Echo "Domain Controller not available: " & arrstrDCs(k)
	    Else
	        On Error GoTo 0
	        
	        Do Until adoRecordset.EOF
	            strDN = adoRecordset.Fields("distinguishedName").Value
	            Set objUser = GetObject("LDAP://" & arrstrDCs(k) & "/" & strDN)
	            On Error Resume Next
	            'Set objDate = adoRecordset.Fields("lastFailedLogin").Value
	            'Set objDate = objUser.lastFailedLogin
	            dtmDate = objUser.lastFailedLogin
	            strAllDCs = strAllDCs & VbCrLf & arrstrDCs(k) & ": " & dtmDate
	            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
	 
	' Output latest lastLogon date for each user.
	For Each strUser In objList.Keys
	    strDetails = objList.Item(strUser)
	Next
	 
	' Uncomment the line below to show all valid logins from all domain controllers
	'MsgBox strAllDCs
	Get_Last_Failed_Login = Trim(Split(strDetails, ";")(0))
 
	' Clean up.
	adoConnection.Close
	Set objRootDSE = Nothing
	Set adoConnection = Nothing
	Set adoCommand = Nothing
	Set adoRecordset = Nothing
	Set objDC = Nothing
End Function

Open in new window

0
Comment
Question by:sunshineknox
  • 8
  • 5
14 Comments
 
LVL 31

Expert Comment

by:Henrik Johansson
ID: 22615135
The counter is stored in the following user property:
objUser.BadLoginCount
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22619542
Hi, I have modified your code to include the objUser.BadLoginCount
Test it out and see if it works. I've never used that property....

Regards,

Rob.
Option Explicit
'On Error Resume Next
 
Dim WSHShell, WSHProcess, strUserName, strHostName, strCommand
 
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
 
Set WSHShell = CreateObject("Wscript.Shell")
Set WSHProcess = WSHShell.Environment("Process")
 
strUserName = WSHProcess("USERNAME")
strHostName = WSHProcess("COMPUTERNAME")
 
 
Dim objShell, strComputer, objWMIService, colComputerIP, IPConfig, intIPCount, strIPAddress, strFullIP
Dim  objFSO, objFile, strOutputFile
Dim strContents, arrLinesInFile, intLineCount, intMaxLinesAllowed, dteLastLogon
Dim objADSysInfo, objUser, dteLastFailedLogin
strComputer = "."
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
Set objShell = CreateObject("WScript.Shell")
 
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colComputerIP = objWMIService.ExecQuery _
    ("Select * from Win32_NetworkAdapterConfiguration")
 
For Each IPConfig in colComputerIP
      If Not IsNull(IPConfig.IPAddress) Then
        For intIPCount = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
                strIPAddress = strIPAddress & "IP Address: " & IPConfig.IPAddress(intIPCount) & "~"
            Next
      End If
Next
 
If InStr(strIPAddress, "192.168.20.") > 0 Then
      strFullIP = Mid(strIPAddress, InStr(strIPAddress, "192.168.20."), InStr(InStr(strIPAddress, "192.168.20."), strIPAddress, "~") - InStr(strIPAddress, "192.168.20."))
ElseIf InStr(strIPAddress, "192.168.30.") > 0 Then
      strFullIP = Mid(strIPAddress, InStr(strIPAddress, "192.168.30."), InStr(InStr(strIPAddress, "192.168.30."), strIPAddress, "~") - InStr(strIPAddress, "192.168.30."))
Else
      strFullIP = "UNKNOWN"
End If
 
If Len(strFullIP) > 1 And Right(strFullIP, 1) = "~" Then
      strFullIP = Left(strFullIP, Len(strFullIP) - 1)
End If
      
' /////// Define the text file name as the name of the user //////////
strOutputFile = "\\corpfs01\userLogins\" & strUserName & ".txt"
 
On Error Resume Next
 
Set objADSysInfo = CreateObject("ADSystemInfo")
strUserDN = objADSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUserDN)
 
'/////// Open the user's text file for reading first to be able to count the number of lines ///////
'Set objFile = objFSO.OpenTextFile ("\\corpfs01\UserLogins\" & strOutputFile, ForAppending, True)
Set objFile = objFSO.OpenTextFile (strOutputFile, ForReading, True)
 
'////// Set this value to the maximum number of entries allowed per user's text file
'////// Set this value to 0 or -1 to have unlimited lines
intMaxLinesAllowed = -1
 
strContents = ""
strContents = objFile.ReadAll
 
If Len(strContents) > 0 Then
      arrLinesInFile = Split(strContents, vbCrLf)
      dteLastLogon = Trim(Split(arrLinesInFile(0), "|")(2))
      dteLastFailedLogin = Get_Last_Failed_Login
      MsgBox "You last logged on at " & dteLastLogon & VbCrLf & _
      	"Your last failed logon was " & dteLastFailedLogin & VbCrLf & _
      	"You have had " & objUser.BadLoginCount & " bad login attempts since your last logon."
      If intMaxLinesAllowed > 0 Then
            If UBound(arrLinesInFile) > (intMaxLinesAllowed - 1) Then
                  strContents = ""
                  For intLineCount = 0 To (intMaxLinesAllowed - 2)
                        strContents = strContents & arrLinesInFile(intLineCount) & VbCrLf
                  Next
                  strContents = strContents & arrLinesInFile((intMaxLinesAllowed - 1))
            End If
      End If
End If
 
'MsgBox "There are " & UBound(arrLinesInFile) & " lines in the file before adding 1."
 
Set objFile = objFSO.OpenTextFile (strOutputFile, ForWriting, True)
objFile.Write(Pad_String(strFullIP, 20, "Right", " ") & "|  " & Pad_String(strHostName, 24, "Right", " ") & "|  " & Now & VbCrLf & strContents)
 
objFile.Close
 
On Error Goto 0
 
 
'*************************************************************
 
Function Pad_String(strOriginalString, intTotalLengthRequired, strPaddingSide, strCharacterToPadWith)
	If LCase(strPaddingSide) <> "left" And LCase(strPaddingSide) <> "right" Then
		strPaddingSide = "right"
	End If
	Select Case LCase(strPaddingSide)
		Case "left" 
			Pad_String = Right(String(intTotalLengthRequired, Left(strCharacterToPadWith, 1)) & strOriginalString, intTotalLengthRequired)
		Case "right" 
			Pad_String = Left(strOriginalString & String(intTotalLengthRequired, Left(strCharacterToPadWith, 1)), intTotalLengthRequired)
	End Select
End Function
 
Function Get_Last_Failed_Login
	Dim objShell
	Dim objRootDSE, strConfig, adoConnection, adoCommand, strQuery
	Dim adoRecordset, objDC
	Dim objADSysInfo, strUserDN
	'Dim objShell
	Dim strOU, strDNSDomain, lngBiasKey, lngBias, k, arrstrDCs()
	Dim strDN, dtmDate, objDate, objList, strUser
	Dim strBase, strFilter, strAttributes, lngHigh, lngLow, strAllDCs, objUser
	 
	' Use a dictionary object to track latest lastLogon for each user.
	Set objList = CreateObject("Scripting.Dictionary")
	objList.CompareMode = vbTextCompare
	 
	Set objADSysInfo = CreateObject("ADSystemInfo")
	strUserDN = objADSysInfo.UserName
	 
	' 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.
	 
	Dim strDetails
	 
	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
	 
	' Retrieve lastLogon attribute for each user on each Domain Controller.
	strAllDCs = "All Domain Controller data:"
	For k = 0 To Ubound(arrstrDCs)
	    strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
	    strFilter = "(&(objectCategory=person)(objectClass=user)(distinguishedName=" & strUserDN & "))"
	    strAttributes = "distinguishedName"
	    strQuery = strBase & ";" & strFilter & ";" & strAttributes _
	        & ";subtree"
	    adoCommand.CommandText = strQuery
	    On Error Resume Next
	    Set adoRecordset = adoCommand.Execute
	    If (Err.Number <> 0) Then
	        On Error GoTo 0
	        Wscript.Echo "Domain Controller not available: " & arrstrDCs(k)
	    Else
	        On Error GoTo 0
	        
	        Do Until adoRecordset.EOF
	            strDN = adoRecordset.Fields("distinguishedName").Value
	            Set objUser = GetObject("LDAP://" & arrstrDCs(k) & "/" & strDN)
	            On Error Resume Next
	            'Set objDate = adoRecordset.Fields("lastFailedLogin").Value
	            'Set objDate = objUser.lastFailedLogin
	            dtmDate = objUser.lastFailedLogin
	            strAllDCs = strAllDCs & VbCrLf & arrstrDCs(k) & ": " & dtmDate
	            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
	 
	' Output latest lastLogon date for each user.
	For Each strUser In objList.Keys
	    strDetails = objList.Item(strUser)
	Next
	 
	' Uncomment the line below to show all valid logins from all domain controllers
	'MsgBox strAllDCs
	Get_Last_Failed_Login = Trim(Split(strDetails, ";")(0))
 
	' Clean up.
	adoConnection.Close
	Set objRootDSE = Nothing
	Set adoConnection = Nothing
	Set adoCommand = Nothing
	Set adoRecordset = Nothing
	Set objDC = Nothing
End Function

Open in new window

0
 

Author Comment

by:sunshineknox
ID: 22623806
Hey RobSampson glad to here from you again.  I tried to run the script and I didn't get anything.  I didn't get  errors to troubleshoot with.  As always thanks for your help.

0
Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

 

Author Comment

by:sunshineknox
ID: 22624210
I did a wscript.echo strUserDN under this:

Set objADSysInfo = CreateObject("ADSystemInfo")
strUserDN = objADSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUserDN)

I didn't get any information back, hope this can help.



0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22628523
Hi, did you post this to the wrong question?  Are you referring to the code above that you tested?

Rob
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22629659
Oh wait, my mistake.....you just used the three extra lines that I added...I'll check this out....

Regards,

Rob.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22629806
Hmmmmm, I would say that if you cannot even do this without errors:

Set objADSysInfo = CreateObject("ADSystemInfo")
strUser = "LDAP://" & objADSysInfo.UserName
Set objUser = GetObject(strUser)

Then you've got other issues...possibly related to security on the AD object.

On a domain controller, launch ADUC and right-click a user object, then click Properties.  Then scroll down to SELF and see what permissions they have.  They should have quite a few there.

Regards,

Rob.
0
 

Author Comment

by:sunshineknox
ID: 22632955
Here is what I have for Allows:
Read
Read General Information
Read Group Membership
Read Personal Information
Read Public Information
Read Remote Access Information
Read Account Restrictions
Read logon Information
Read Web Information
0
 

Author Comment

by:sunshineknox
ID: 22634743
Hey Rob,

I found this and thought it might help you out in helping me.  Here is the link:  
http://www.experts-exchange.com/OS/Microsoft_Operating_Systems/Windows/NT/Q_20080805.html

It says the Property's name isn't BadLoginCount, but BadPasswordAttempts.  
0
 

Author Comment

by:sunshineknox
ID: 22636253
Hey Rob,
I had to do a little tweaking, but I think I'm closer now thanks with your help.  I re-located this:

Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

at the beginning of the code.  I also had to use objUser.badpwdcount  to get he Bad login Attempts.   The script works, but I'm not getting the true failed login Attempts if I use this as a logon script because when they successfully login it resets the counter to 0 before it grabs the failed attempts.  I hope this is clear.  If not please let me know.  I feel that youre the only person that's capable of helping me out.  Thanks for all your help.

Option Explicit
'On Error Resume Next
 
Dim WSHShell, WSHProcess, strUserName, strHostName, strCommand, objSysInfo, objUser, strUser
 
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
 
Set WSHShell = CreateObject("Wscript.Shell")
Set WSHProcess = WSHShell.Environment("Process")
 
strUserName = WSHProcess("USERNAME")
strHostName = WSHProcess("COMPUTERNAME")
 
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
 
 
Dim objShell, strComputer, objWMIService, colComputerIP, IPConfig, intIPCount, strIPAddress, strFullIP
Dim  objFSO, objFile, strOutputFile
Dim strContents, arrLinesInFile, intLineCount, intMaxLinesAllowed, dteLastLogon
Dim objADSysInfo, dteLastFailedLogin
strComputer = "."
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
Set objShell = CreateObject("WScript.Shell")
 
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colComputerIP = objWMIService.ExecQuery _
    ("Select * from Win32_NetworkAdapterConfiguration")
 
For Each IPConfig in colComputerIP
      If Not IsNull(IPConfig.IPAddress) Then
        For intIPCount = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
                strIPAddress = strIPAddress & "IP Address: " & IPConfig.IPAddress(intIPCount) & "~"
            Next
      End If
Next
 
If InStr(strIPAddress, "192.168.20.") > 0 Then
      strFullIP = Mid(strIPAddress, InStr(strIPAddress, "192.168.20."), InStr(InStr(strIPAddress, "192.168.20."), strIPAddress, "~") - InStr(strIPAddress, "192.168.20."))
ElseIf InStr(strIPAddress, "192.168.30.") > 0 Then
      strFullIP = Mid(strIPAddress, InStr(strIPAddress, "192.168.30."), InStr(InStr(strIPAddress, "192.168.30."), strIPAddress, "~") - InStr(strIPAddress, "192.168.30."))
Else
      strFullIP = "UNKNOWN"
End If
 
If Len(strFullIP) > 1 And Right(strFullIP, 1) = "~" Then
      strFullIP = Left(strFullIP, Len(strFullIP) - 1)
End If
      
' /////// Define the text file name as the name of the user //////////
strOutputFile = "\\corpfs01\userLogins\" & strUserName & ".txt"
 
On Error Resume Next
 
Set objADSysInfo = CreateObject("ADSystemInfo")
strUserDN = objADSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUserDN)
 
'/////// Open the user's text file for reading first to be able to count the number of lines ///////
'Set objFile = objFSO.OpenTextFile ("\\corpfs01\UserLogins\" & strOutputFile, ForAppending, True)
Set objFile = objFSO.OpenTextFile (strOutputFile, ForReading, True)
 
'////// Set this value to the maximum number of entries allowed per user's text file
'////// Set this value to 0 or -1 to have unlimited lines
intMaxLinesAllowed = -1
 
strContents = ""
strContents = objFile.ReadAll
 
If Len(strContents) > 0 Then
      arrLinesInFile = Split(strContents, vbCrLf)
      dteLastLogon = Trim(Split(arrLinesInFile(0), "|")(2))
      dteLastFailedLogin = Get_Last_Failed_Login
 
     MsgBox "You last logged on at " & dteLastLogon & VbCrLf & "Your last failed logon was " & dteLastFailedLogin _ 
      & VbCrLf & "You have had " & objUser.badpwdcount & " bad login attempts since your last successful logon." _
	& VbCrLf & VbCrLf & "If this information is not accurate, please call helpline.",64,"Security"
 
      If intMaxLinesAllowed > 0 Then
            If UBound(arrLinesInFile) > (intMaxLinesAllowed - 1) Then
                  strContents = ""
                  For intLineCount = 0 To (intMaxLinesAllowed - 2)
                        strContents = strContents & arrLinesInFile(intLineCount) & VbCrLf
                  Next
                  strContents = strContents & arrLinesInFile((intMaxLinesAllowed - 1))
            End If
      End If
End If
 
'MsgBox "There are " & UBound(arrLinesInFile) & " lines in the file before adding 1."
 
Set objFile = objFSO.OpenTextFile (strOutputFile, ForWriting, True)
objFile.Write(Pad_String(strFullIP, 20, "Right", " ") & "|  " & Pad_String(strHostName, 24, "Right", " ") & "|  " & Now & VbCrLf & strContents)
 
objFile.Close
 
On Error Goto 0
 
 
'*************************************************************
 
Function Pad_String(strOriginalString, intTotalLengthRequired, strPaddingSide, strCharacterToPadWith)
	If LCase(strPaddingSide) <> "left" And LCase(strPaddingSide) <> "right" Then
		strPaddingSide = "right"
	End If
	Select Case LCase(strPaddingSide)
		Case "left" 
			Pad_String = Right(String(intTotalLengthRequired, Left(strCharacterToPadWith, 1)) & strOriginalString, intTotalLengthRequired)
		Case "right" 
			Pad_String = Left(strOriginalString & String(intTotalLengthRequired, Left(strCharacterToPadWith, 1)), intTotalLengthRequired)
	End Select
End Function
 
Function Get_Last_Failed_Login
	Dim objShell
	Dim objRootDSE, strConfig, adoConnection, adoCommand, strQuery
	Dim adoRecordset, objDC
	Dim objADSysInfo, strUserDN
	'Dim objShell
	Dim strOU, strDNSDomain, lngBiasKey, lngBias, k, arrstrDCs()
	Dim strDN, dtmDate, objDate, objList, strUser
	Dim strBase, strFilter, strAttributes, lngHigh, lngLow, strAllDCs, objUser
	 
	' Use a dictionary object to track latest lastLogon for each user.
	Set objList = CreateObject("Scripting.Dictionary")
	objList.CompareMode = vbTextCompare
	 
	Set objADSysInfo = CreateObject("ADSystemInfo")
	strUserDN = objADSysInfo.UserName
	 
	' 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.
	 
	Dim strDetails
	 
	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
	 
	' Retrieve lastLogon attribute for each user on each Domain Controller.
	strAllDCs = "All Domain Controller data:"
	For k = 0 To Ubound(arrstrDCs)
	    strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
	    strFilter = "(&(objectCategory=person)(objectClass=user)(distinguishedName=" & strUserDN & "))"
	    strAttributes = "distinguishedName"
	    strQuery = strBase & ";" & strFilter & ";" & strAttributes _
	        & ";subtree"
	    adoCommand.CommandText = strQuery
	    On Error Resume Next
	    Set adoRecordset = adoCommand.Execute
	    If (Err.Number <> 0) Then
	        On Error GoTo 0
	        Wscript.Echo "Domain Controller not available: " & arrstrDCs(k)
	    Else
	        On Error GoTo 0
	        
	        Do Until adoRecordset.EOF
	            strDN = adoRecordset.Fields("distinguishedName").Value
	            Set objUser = GetObject("LDAP://" & arrstrDCs(k) & "/" & strDN)
	            On Error Resume Next
	            'Set objDate = adoRecordset.Fields("lastFailedLogin").Value
	            'Set objDate = objUser.lastFailedLogin
	            dtmDate = objUser.lastFailedLogin
	            strAllDCs = strAllDCs & VbCrLf & arrstrDCs(k) & ": " & dtmDate
	            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
	 
	' Output latest lastLogon date for each user.
	For Each strUser In objList.Keys
	    strDetails = objList.Item(strUser)
	Next
	 
	' Uncomment the line below to show all valid logins from all domain controllers
	'MsgBox strAllDCs
	Get_Last_Failed_Login = Trim(Split(strDetails, ";")(0))
 
	' Clean up.
	adoConnection.Close
	Set objRootDSE = Nothing
	Set adoConnection = Nothing
	Set adoCommand = Nothing
	Set adoRecordset = Nothing
	Set objDC = Nothing
End Function

Open in new window

0
 

Author Comment

by:sunshineknox
ID: 22640629
I'm thinking since the badpwdcount resets to 0 when they have a successful login then maybe there is a way to log it to a text file.  Once it pulls the badpwdcount and notifies the user of the bad password count then it could reset it to the text file to 0 to the badpwdcount.


Thanks,
sunshine

0
 

Author Comment

by:sunshineknox
ID: 22651766
Hey Rob,
Please let me know what you think.  I appreciate all your effort on this.


Sunshine
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 22655436
Hi, sorry for my delay.....having some very busy days....

>> I'm thinking since the badpwdcount resets to 0 when they have a successful login then maybe there is a way to log it to a text file.

Unfortunately, because this script runs *when* the user successfully logs in, any bad login attempt counter will always reset, and the login script will capture that reset.  You will not be able to run a script before the user logs in.....

The only way you can view the bad login count is to bind to the user account before they successfully log in, but you can only do by using another user account.......

So I don't actually think this can be done.........

I guess, if you really must have this count, you could run a script on the domain controller every night that would capture the bad login count for all users *at that time*, but that's the best you could do.

Regards,

Rob.
0
 

Author Closing Comment

by:sunshineknox
ID: 31501981
Thanks RobSampson.  The notify of last failed should be good enough.  I Appreciate your insight on this matter.  
0

Featured Post

Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Is your Office 365 signature not working the way you want it to? Are signature updates taking up too much of your time? Let's run through the most common problems that an IT administrator can encounter when dealing with Office 365 email signatures.
This article shows how to deploy dynamic backgrounds to computers depending on the aspect ratio of display
This tutorial will walk an individual through the steps necessary to join and promote the first Windows Server 2012 domain controller into an Active Directory environment running on Windows Server 2008. Determine the location of the FSMO roles by lo…
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question