Advertisement

09.29.2008 at 08:12AM PDT, ID: 23771607 | Points: 500
[x]
Attachment Details

Modify VB Script to show the number of unsuccessful logon attempts since the last successful logon

Asked by sunshineknox in VB Script

I need this VB script modified to show the number of unsuccessful logon attempts since the last successful logon.

ThanksStart 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
[+][-]09.29.2008 at 10:24AM PDT, ID: 22598509

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.

 
[+][-]09.29.2008 at 12:40PM PDT, ID: 22599884

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.

 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_2_20070628