' MoveOldComputers.vbs ' VBScript program to determine when each computer account in the domain ' last had their password changed. If this date is more than a specified ' number of days in the past, the computer object is considered inactive ' and it is moved to a target Organizational Unit. The computer account ' is also disabled. A log file keeps track of which computer objects are ' moved. ' ' ---------------------------------------------------------------------- ' Copyright (c) 2004-2010 Richard L. Mueller ' Hilltop Lab web site - http://www.rlmueller.net ' Version 1.0 - February 8, 2004 ' Version 1.1 - February 23, 2004 - Bug fix. ' Version 1.2 - July 6, 2007 - Modify how IADsLargeInteger interface ' is invoked. ' Version 1.3 - July 31, 2007 - Escape any "/" characters in computer ' DNs. ' Version 1.4 - December 29, 2009 - Modify function Integer8Date. ' Version 1.5 - November 6, 2010 - No need to set objects to Nothing. ' Version 1.6 - April 9, 2011 - Only consider computers not disabled. ' ' You have a royalty-free right to use, modify, reproduce, and ' distribute this script file in any way you find useful, provided that ' you agree that the copyright owner above has no warranty, obligations, ' or liability for such use. Option Explicit Dim strFilePath, objFSO, objFile, adoConnection, adoCommand Dim objRootDSE, strDNSDomain, strFilter, strQuery, adoRecordset Dim strComputerDN, objShell, lngBiasKey, lngBias Dim objDate, dtmPwdLastSet, k Dim intDays, strTargetOU, objTargetOU, objComputer Dim intTotal, intInactive, intNotMoved, intNotDisabled ' Specify the log file. This file will be created if it does not ' exist. Otherwise, the program will append to the file. strFilePath = "c:\MyFolder\OldComputers.log" ' Specify the minimum number of days since the password was last set for ' the computer account to be considered inactive. intDays = 180 ' Specify the Distinguished Name of the Organizational Unit into ' which inactive computer objects will be moved. strTargetOU = "ou=Inactive,dc=MyDomain,dc=com" ' Bind to target Organizational Unit. On Error Resume Next Set objTargetOU = GetObject("LDAP://" & strTargetOU) If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "Organization Unit not found: " & strTargetOU Wscript.Quit End If On Error GoTo 0 ' Open the log file for write access. Append to this file. Set objFSO = CreateObject("Scripting.FileSystemObject") On Error Resume Next Set objFile = objFSO.OpenTextFile(strFilePath, 8, True, 0) If (Err.Number <> 0) Then On Error GoTo 0 Wscript.Echo "File " & strFilePath & " cannot be opened" Wscript.Quit End If On Error GoTo 0 ' 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 ' Use ADO to search the domain for all computers. Set adoConnection = CreateObject("ADODB.Connection") Set adoCommand = CreateObject("ADODB.Command") adoConnection.Provider = "ADsDSOOBject" adoConnection.Open "Active Directory Provider" Set adoCommand.ActiveConnection = adoConnection ' Determine the DNS domain from the RootDSE object. Set objRootDSE = GetObject("LDAP://RootDSE") strDNSDomain = objRootDSE.Get("DefaultNamingContext") ' Filter to retrieve all computer objects, not disabled. strFilter = "(&(objectCategory=computer)" _ & "(!userAccountControl:1.2.840.113556.1.4.803:=2))" ' Retrieve Distinguished Name and date password last set. strQuery = ";" & strFilter _ & ";distinguishedName,pwdLastSet;subtree" adoCommand.CommandText = strQuery adoCommand.Properties("Page Size") = 100 adoCommand.Properties("Timeout") = 30 adoCommand.Properties("Cache Results") = False ' Write information to log file. objFile.WriteLine "Search for Inactive Computer Accounts" objFile.WriteLine "Start: " & Now() objFile.WriteLine "Base of search: " & strDNSDomain objFile.WriteLine "Log File: " & strFilePath objFile.WriteLine "Inactive if password not set in days: " & intDays objFile.WriteLine "Inactive accounts moved to: " & strTargetOU objFile.WriteLine "----------------------------------------------" ' Initialize totals. intTotal = 0 intInactive = 0 intNotMoved = 0 intNotDisabled = 0 ' Enumerate all computers and determine which are inactive. Set adoRecordset = adoCommand.Execute Do Until adoRecordset.EOF strComputerDN = adoRecordset.Fields("distinguishedName").Value ' Escape any forward slash characters, "/", with the backslash ' escape character. All other characters that should be escaped are. strComputerDN = Replace(strComputerDN, "/", "\/") intTotal = intTotal + 1 ' Determine date when password last set. ' The pwdLastSet attribute should always have a value assigned, ' but other Integer8 attributes representing dates could be "Null". 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 ' Check if computer object inactive. If (DateDiff("d", dtmPwdLastSet, Now()) > intDays) Then ' Computer object inactive. intInactive = intInactive + 1 objFile.WriteLine "Inactive: " & strComputerDN _ & " - password last set: " & dtmPwdLastSet ' Move computer object to the target OU. On Error Resume Next Set objComputer = objTargetOU.MoveHere("LDAP://" _ & strComputerDN, vbNullString) If (Err.Number <> 0) Then On Error GoTo 0 intNotMoved = intNotMoved + 1 objFile.WriteLine "Cannot move: " & strComputerDN End If ' Disable the computer account. On Error Resume Next objComputer.AccountDisabled = True ' Save changes to Active Directory. objComputer.SetInfo If (Err.Number <> 0) Then On Error GoTo 0 intNotDisabled = intNotDisabled + 1 objFile.WriteLine "Cannot disable: " & strComputerDN End If On Error GoTo 0 End If adoRecordset.MoveNext Loop adoRecordset.Close ' Write totals to log file. objFile.WriteLine "Finished: " & Now() objFile.WriteLine "Total computer objects found: " & intTotal objFile.WriteLine "Inactive: " & intInactive objFile.WriteLine "Inactive accounts not moved: " & intNotMoved objFile.WriteLine "Inactive accounts not disabled: " & intNotDisabled objFile.WriteLine "----------------------------------------------" ' Display summary. Wscript.Echo "Computer objects found: " & intTotal Wscript.Echo "Inactive: " & intInactive Wscript.Echo "Inactive accounts not moved: " & intNotMoved Wscript.Echo "Inactive accounts not disabled: " & intNotDisabled Wscript.Echo "See log file: " & strFilePath ' Clean up. objFile.Close adoConnection.Close Wscript.Echo "Done" 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