Number of days that the krbtgt password is allowed to age
Source Code:
<DataSourceModuleType ID="Microsoft.Windows.AD.DomainMemberPerspective.Security.KrbtgtPasswordLastSet.DataSource" Accessibility="Internal" Batching="false">
<Configuration>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="IntervalSeconds" type="xsd:int"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="TimeoutSeconds" type="xsd:int"/>
<xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="Threshold" type="xsd:int"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" Selector="$Config/IntervalSeconds$" ParameterType="int"/>
<OverrideableParameter ID="TimeoutSeconds" Selector="$Config/TimeoutSeconds$" ParameterType="int"/>
<OverrideableParameter ID="Threshold" Selector="$Config/Threshold$" ParameterType="int"/>
</OverrideableParameters>
<ModuleImplementation Isolation="Any">
<Composite>
<MemberModules>
<DataSource ID="DS" TypeID="System!System.CommandExecuterPropertyBagSource">
<IntervalSeconds>$Config/IntervalSeconds$</IntervalSeconds>
<ApplicationName>%windir%\system32\cscript.exe</ApplicationName>
<WorkingDirectory/>
<CommandLine>//nologo $file/KRBTGT_Password_Last_Set.vbs$ $Config/Threshold$</CommandLine>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>KRBTGT_Password_Last_Set.vbs</Name>
<Contents><Script>'*************************************************************************
' Script Name - KRBTGT_Password_Last_Set.vbs
'
' Purpose - Monitors the age of the krbtgt password
'
' (c) Copyright 2014, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
Option Explicit
SetLocale("en-us")
Sub Main()
Dim oParams, oAPI, oBag, sError, iThreshold, oADO, oCmd, oRoot, strDNSDomain, oRecords
Set oParams = WScript.Arguments
Set oAPI = CreateObject("Mom.ScriptAPI")
Set oBag = oAPI.CreatePropertyBag()
if oParams.Count <> 1 then
sError = "The number of command line arguments is incorrect: " & vbCrLf & _
"Expected: 1" & vbCrLf & _
"Actual: " & oParams.Count
' Obtain local time zone bias from machine registry.
' This bias changes with Daylight Savings Time.
dim oShell, lBiasKey, lBias, sRegKey
sRegKey = "HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
Set oShell = CreateObject("Wscript.Shell")
lBiasKey = oShell.RegRead(sRegKey)
If Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Unable to read local registry. Verfiy registry" _
& " access and that the following key exists: " & vbCrLf _
& sRegKey & vbCrlf & GetErrorString(Err)
Call oAPI.Return(oBag)
Exit Sub
End IF
If (UCase(TypeName(lBiasKey)) = "LONG") Then
lBias = lBiasKey
ElseIf (UCase(TypeName(lBiasKey)) = "VARIANT()") Then
lBias = 0
For k = 0 To UBound(lBiasKey)
lBias = lBias + (lBiasKey(k) * 256^k)
Next
End If
' Connect to AD and lookup krbtgt user object to find when its password was last set.
Set oADO = CreateObject("ADODB.Connection")
If Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Unable to create ADODB Connection." & GetErrorString(Err)
Call oAPI.Return(oBag)
Exit Sub
End IF
Set oCmd = CreateObject("ADODB.Command")
If Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Unable to create ADODB Command." & GetErrorString(Err)
set oRoot = GetObject("LDAP://RootDSE")
If Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Unable to connect to the Root DSE. Local DC may not be responding to LDAP requests" & GetErrorString(Err)
Call oAPI.Return(oBag)
Exit Sub
End If
strDNSDomain = oRoot.Get("defaultNamingContext")
If Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Unable to connect to the default naming context." & GetErrorString(Err)
Call oAPI.Return(oBag)
Exit Sub
End If
oCmd.CommandText = "<LDAP://" & strDNSDomain & ">;(cn=krbtgt);distinguishedName,pwdLastSet;subtree"
set oRecords = oCmd.Execute
If Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Unable to query the domain for the krbtgt account." & vbCrLf & _
"Query: " & oCmd.CommandText & vbCrLf & GetErrorString(Err)
Call oAPI.Return(oBag)
Exit Sub
End If
dim oDate, dDate, dDateDiff
Set oDate = ORecords.Fields("pwdLastSet").Value
dDate = Integer8Date(oDate, lBias)
dDateDiff = DateDiff("d", dDate, Date)
' Compare the age in password by days to the threshold passed in to the script to determine state
if (iThreshold > dDateDiff) Then
oBag.AddValue "State", "GOOD"
Else
sError = "The number of days since the krbtgt password was reset is greater than the configured threshold:" & vbCrLf & _
"Password last set on: "& CStr(dDate) & vbCrLf & _
"Days since password Change: " & dDateDiff & vbCrLf & _
"Threshold (days): " & iThreshold
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", sError
End If
Call oAPI.Return(oBag)
End Sub
'******************************************************************************
' Name: GetErrorString
'
' Purpose: Attempts to find the description for an error if an error with
' no description is passed in.
'
' Parameters: oErr, the error object
'
' Return: String, the description for the error. (Includes the error code.)
'
Function GetErrorString(oErr)
Dim lErr, strErr
lErr = oErr
strErr = oErr.Description
On Error Resume Next
If 0 >= Len(strErr) Then
' If we don't have an error description, then check to see if the error
' is a 0x8007xxxx error. If it is, then look it up.
Const ErrorMask = &HFFFF0000
Const HiWord8007 = &H80070000
Const LoWordMask = 65535 ' This is equivalent to 0x0000FFFF
If (lErr And ErrorMask) = HiWord8007 Then
' Attempt to use 'net helpmsg' to get a description for the error.
Dim oShell
Set oShell = CreateObject("WScript.Shell")
If Err = 0 Then
Dim oExec
Set oExec = oShell.Exec("net helpmsg " & (lErr And LoWordMask))
Dim strMessage, i
Do
strMessage = oExec.stdout.ReadLine()
i = i + 1
Loop While (Len(strMessage) = 0) And (i < 5)
strErr = strMessage
End If
End If
End If
GetErrorString = vbCrLf & vbCrLf & "The error returned was: '" & strErr & "' (0x" & Hex(lErr) & ")"
End Function
'******************************************************************************
' Name: Integer8Date
'
' Purpose: Converts AD 64 bit integer into a date and adjusts for local
' time zone. (Copied from technet gallery)
' https://gallery.technet.microsoft.com/scriptcenter/fb93f239-e123-4af0-9a6b-a0af7ffa136f
'
' Parameters: objDate, the date object returned from AD
' lBias, the time zone bias of the local machine
'
' Return: Date, The date value converted from the 64bit integer passed in.
'
Function Integer8Date(ByVal objDate, ByVal lBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
Dim lngAdjust, lngDate, lngHigh, lngLow
lngAdjust = lBias
lngHigh = objDate.HighPart
lngLow = objdate.LowPart
' Account for error in IADsLargeInteger property methods.
If (lngLow < 0) Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0) Then
lngAdjust = 0
End If
lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow) / 600000000 - lngAdjust) / 1440
' Trap error if lngDate is ridiculously huge.
On Error Resume Next
Integer8Date = CDate(lngDate)
If (Err.Number <> 0) Then
On Error GoTo 0
Integer8Date = #1/1/1601#
End If
End Function
Home
ENU 
Show References: