Parola süresi dolmuş kullanıcılar listesi raporunu oluşturma ve dışa aktarma

function foo Dim adoCommand, adoConnection, strBase, strFilter, strAttributes Dim objRootDSE, strDNSDomain, strQuery, adoRecordset Dim dtmDate2, strName, strEmail Dim lngSeconds2, str64Bit2 Dim objShell, lngBiasKey, lngBias, k Dim objDomain, objMaxPwdAge, lngHighAge, lngLowAge, sngMaxPwdAge Dim objDate, dtmPwdLastSet, dtmExpires Dim strItem, strPrefix, objFSO, objLogFile Const ForWriting = 2 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objLogFile = objFSO.CreateTextFile("C:\Scripts\PasswordExp.csv", ForWriting, True) objLogFile.Write "sAMAccountName," objLogFile.Write "mail," objLogFile.Write "passwordExpiresAt" objLogFile.Writeline ' Determine domain maximum password age policy in days. Set objRootDSE = GetObject("LDAP://RootDSE") strDNSDomain = objRootDSE.Get("DefaultNamingContext") Set objDomain = GetObject("LDAP://" & strDNSDomain) Set objMaxPwdAge = objDomain.MaxPwdAge lngHighAge = objMaxPwdAge.HighPart lngLowAge = objMaxPwdAge.LowPart If (lngLowAge < 0) Then lngHighAge = lngHighAge + 1 End If ' Convert from 100-nanosecond intervals into days. sngMaxPwdAge = -((lngHighAge * 2^32) _ + lngLowAge)/(600000000 * 1440) dtmDate2 = DateAdd("d", - sngMaxPwdAge, Now()) ' Obtain local Time Zone bias from machine registry. ' This bias changes with Daylight Savings Time. 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 dtmDate2 = DateAdd("n", lngBias, dtmDate2) lngSeconds2 = DateDiff("s", #1/1/1601#, dtmDate2) str64Bit2 = CStr(lngSeconds2) & "0000000" ' Setup ADO objects. Set adoCommand = CreateObject("ADODB.Command") Set adoConnection = CreateObject("ADODB.Connection") adoConnection.Provider = "ADsDSOObject" adoConnection.Open "Active Directory Provider" Set adoCommand.ActiveConnection = adoConnection ' Search entire Active Directory domain. strBase = "<ldap: "="" &="" strdnsdomain="">" '  ' strFilter = "(&(objectCategory=person)(objectClass=user)" _ & "(!pwdLastSet=0)" _ & "(pwdLastSet<=" & str64Bit2 & ")" _ & "(!userAccountControl:1.2.840.113556.1.4.803:=2)" _ & "(!userAccountControl:1.2.840.113556.1.4.803:=65536)" _ & "(!userAccountControl:1.2.840.113556.1.4.803:=32)" _ & "(!userAccountControl:1.2.840.113556.1.4.803:=48))" ' Comma delimited list of attribute values to retrieve. strAttributes = "sAMAccountName,mail,pwdLastSet" ' Construct the LDAP syntax query. strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" adoCommand.CommandText = strQuery 'Filter on user objects where the password expires between the dates specified, the account is not disabled, password never expires is not set, password not required is not set, and password cannot change is not set.' adoCommand.Properties("Page Size") = 100 adoCommand.Properties("Timeout") = 30 adoCommand.Properties("Cache Results") = False ' Run the query. Set adoRecordset = adoCommand.Execute ' Enumerate the resulting recordset. Do Until adoRecordset.EOF strName = adoRecordset.Fields("sAMAccountName").Value strEmail = adoRecordset.Fields("mail").Value & "" If (TypeName(adoRecordset.Fields("pwdLastSet").Value) = "Object") Then Set objDate = adoRecordset.Fields("pwdLastSet").Value dtmPwdLastSet = Integer8Date(objDate, lngBias) Else dtmPwdLastSet = #1/1/1601# End If dtmExpires = DateAdd("d", sngMaxPwdAge, dtmPwdLastSet) objLogFile.Write strName & "," objLogFile.Write strEmail & "," objLogFile.Write dtmExpires objLogFile.Writeline adoRecordset.MoveNext Loop ' Clean up. objLogFile.Close adoRecordset.Close adoConnection.Close Function Integer8Date(ByVal objDate, ByVal lngBias) ' Function to convert Integer8 (64-bit) value to a date, adjusted for ' local time zone bias. Dim lngAdjust, lngDate, lngHigh, lngLow lngAdjust = lngBias 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 On Error GoTo 0 End Function