Advertisement

10.01.2008 at 07:21AM PDT, ID: 23778034
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!

8.6

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

Asked by sunshineknox in VB Script, Miscellaneous Programming, Active Directory

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.

Start Free Trial
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
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
 
 
[+][-]10.01.2008 at 08:05AM PDT, ID: 22615135

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]10.01.2008 at 03:00PM PDT, ID: 22619542

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]10.02.2008 at 06:10AM PDT, ID: 22623806

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]10.02.2008 at 06:53AM PDT, ID: 22624210

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]10.02.2008 at 01:56PM PDT, ID: 22628523

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]10.02.2008 at 04:27PM PDT, ID: 22629659

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]10.02.2008 at 04:54PM PDT, ID: 22629806

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]10.03.2008 at 05:03AM PDT, ID: 22632955

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]10.03.2008 at 08:11AM PDT, ID: 22634743

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]10.03.2008 at 10:49AM PDT, ID: 22636253

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]10.04.2008 at 05:57AM PDT, ID: 22640629

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]10.06.2008 at 09:33AM PDT, ID: 22651766

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]10.06.2008 at 04:36PM PDT, ID: 22655436

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zones: VB Script, Miscellaneous Programming, Active Directory
Sign Up Now!
Solution Provided By: RobSampson
Participating Experts: 2
Solution Grade: A
 
 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_2_20070628