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:
|
const DAYS_DIFF = 10
const ROOT_OU = "cn=computers"
const LOG_FILE = "C:\temp\Last_Logon.log"
Dim objRootDSE, strConfig, objConnection, objCommand, strQuery
Dim objRecordSet, objDC, f, fso
Dim strDNSDomain, objShell, lngBiasKey, lngBias, k, arrstrDCs()
Dim strDN, dtmDate, objDate, lngDate, objList, strUser
Dim strBase, strFilter, strAttributes, lngHigh, lngLow, logContent
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile(LOG_FILE, 2, True)
' Use a dictionary object to track latest lastLogon for each user.
Set objList = CreateObject("Scripting.Dictionary")
objList.CompareMode = vbTextCompare
' 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 objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strBase = "<LDAP://" & strConfig & ">"
strFilter = "(objectClass=nTDSDSA)"
strAttributes = "AdsPath"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 60
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute
' Enumerate parent objects of class nTDSDSA. Save Domain Controller
' AdsPaths in dynamic array arrstrDCs.
k = 0
Do Until objRecordSet.EOF
Set objDC = _
GetObject(GetObject(objRecordSet.Fields("AdsPath")).Parent)
ReDim Preserve arrstrDCs(k)
arrstrDCs(k) = objDC.DNSHostName
k = k + 1
objRecordSet.MoveNext
Loop
' Retrieve lastLogon attribute for each user on each Domain Controller.
For k = 0 To UBound(arrstrDCs)
if ROOT_OU <> "" then
strBase = "<LDAP://" & arrstrDCs(k) & "/" & ROOT_OU & "," & strDNSDomain & ">"
else
strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
end if
strFilter = "(&(objectCategory=computer)(objectClass=computer))"
strAttributes = "CN,lastLogon"
strQuery = strBase & ";" & strFilter & ";" & strAttributes _
& ";subtree"
objCommand.CommandText = strQuery
On Error Resume Next
Err.Clear
Set objRecordSet = objCommand.Execute
If Err.Number <> 0 Then
Err.Clear
On Error GoTo 0
Else
Dim i 'As Integer
On Error GoTo 0
Do Until objRecordSet.EOF
strDN = objRecordSet.Fields("CN")
lngDate = objRecordSet.Fields("lastLogon")
On Error Resume Next
Err.Clear
Set objDate = lngDate
If Err.Number <> 0 Then
Err.Clear
dtmDate = #1/1/1601#
Else
lngHigh = objDate.HighPart
lngLow = objDate.LowPart
If lngLow < 0 Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0) Then
dtmDate = #1/1/1601#
Else
dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow) / 600000000 - lngBias) / 1440
End If
End If
On Error GoTo 0
If objList.Exists(strDN) Then
If dtmDate > objList(strDN) Then
objList(strDN) = dtmDate
End If
Else
objList.Add strDN, dtmDate
End If
objRecordSet.MoveNext
Loop
End If
Next
For Each strUser In objList
objDate = CDate(objList(strUser))
diffDays = DateDiff("d",objDate,Date)
If diffDays > DAYS_DIFF Then
logContent = logContent & strUser & ";" & objList(strUser) & vbNewLine
End If
Next
objTextFile.WriteLine logContent
objTextFile.Close
NotifyByEmail "Machines LastLogon Email Notification", logContent
objConnection.Close
Set objRootDSE = Nothing
Set objConnection = Nothing
Set objCommand = Nothing
Set objRecordSet = Nothing
Set objDC = Nothing
Set objDate = Nothing
Set objList = Nothing
Set objShell = Nothing
MsgBox "done"
sub NotifyByEmail(strSubject, strResult)
Dim ToAddress
Dim MessageSubject
Dim MessageBody
Dim MessageAttachment
dim myRecipient,olMailItem
Dim ol, ns, newMail
ToAddress = "[email protected]"
MessageSubject = strSubject
MessageBody = strResult
Set ol = WScript.CreateObject("Outlook.Application")
Set ns = ol.getNamespace("MAPI")
ns.logon "","",true,false
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.Body = MessageBody & vbCrLf
' validate the recipient, just in case...
Set myRecipient = ns.CreateRecipient(ToAddress)
myRecipient.Resolve
If Not myRecipient.Resolved Then
MsgBox "unknown recipient"
Else
newMail.Recipients.Add(myRecipient)
newMail.Send
End If
Set ol = Nothing
end sub
|
