Solved

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

Posted on 2008-10-01
14
1,014 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
 

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

Join & Write a Comment

This is about my first experience with programming Arduino.
Find out how to use Active Directory data for email signature management in Microsoft Exchange and Office 365.
An introduction to basic programming syntax in Java by creating a simple program. Viewers can follow the tutorial as they create their first class in Java. Definitions and explanations about each element are given to help prepare viewers for future …
This tutorial will walk an individual through the process of configuring their Windows Server 2012 domain controller to synchronize its time with a trusted, external resource. Use Google, Bing, or other preferred search engine to locate trusted NTP …

760 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

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now