Advertisement
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.
Your Input Matters 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! |
||
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
|