Option Explicit

Dim objConn, objCmd, objRS, objComp, objDate, objFSO, objFile
Dim strQuery, arrProvider, strFilter, strFields, strScope

'Time
Dim lngBias

' User Changeable
Const OUT_FILE = "computers.csv"
'Current Machines
Const intDays = 150

' Constants
Const forREADING = 1
Const forWRITING = 2
Const forAPPENDING = 8

getTopLevelOUs()
				
strFilter = "(objectCategory=computer);"
strFields = "distinguishedName"
strScope = ";subtree"

Set objConn = CreateObject("ADODB.Connection")
Set objCmd = CreateObject("ADODB.Command")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
objCmd.ActiveConnection = objConn

'wscript.echo Ubound(arrProvider)
Dim i
for i=0 to Ubound(arrProvider)
  strQuery = "<" & arrProvider(i) & ">;" & strFilter & strFields & strScope
  'wscript.echo i
  getComputers(strQuery)
next

objConn.Close
Set objConn = Nothing
Set objCmd = Nothing

wscript.echo "Done"

Sub getTopLevelOUs
	Dim objRootDSE, strBaseConnString, objOULevel, objOUObject, tmp
	
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strBaseConnString = objRootDSE.Get("defaultNamingContext")
	Set objOULevel = GetObject("LDAP://" & strBaseConnString)
	tmp = ""
	For Each objOUObject In objOULevel
		tmp = tmp & "LDAP://" & objOUObject.distinguishedName & "|"
	next
	tmp = left(tmp,len(tmp)-1)
	
	arrProvider = split(tmp,"|")
End Sub

Sub getComputers(qry)
    Dim strName, dtmPwdLastSet, strOU, strSite, strOut, strTopOU
	Dim comp, tmp, disabled
	objCmd.CommandText = qry
	objCmd.Properties("Page Size") = 1000
	objCmd.Properties("Timeout") = 300
	objCmd.Properties("Cache Results") = False
	objCmd.Properties("Size Limit") = 75000
	Set objRs = objCmd.Execute
	
	strOut = ""
	While Not objRs.EOF
	  if strOut <> "" Then
		strOut = strOut & vbcrlf
	  end if
	  ' Get the LDAP Record
	  ' use distinguished name to provide a direct link to the object
	  comp = "LDAP://" & objRs.Fields("distinguishedName")
	  ' Create a Computer object
	  Set objComp = GetObject(comp)
	  Set objDate = objComp.PwdLastSet
	  dtmPwdLastSet = Integer8Date(objDate, lngBias)
	  
	  'Is Computer account Disabled?
	  If objComp.AccountDisabled <> 0 Then
		disabled = "TRUE"
	  else
		disabled = "FALSE"
	  end if
	  
	  strName = objComp.sAMAccountName
	  strName = left(strName,len(strName)-1)
	  
	  ' Normalise OU so it is user friendly and get site 
	  tmp = Split(objComp.distinguishedName,",")
	  strOU = ""
	  Dim i
	  for i = Ubound(tmp) to 1 Step -1
		if (i = Ubound(tmp)) then
		  strOU = right(tmp(i-1),len(tmp(i-1))-3) & "." & right(tmp(i),len(tmp(i))-3)
		  strTopOU = right(tmp(i-2),len(tmp(i-2))-3)
		  i = i-1
		else
		  strOU = strOU & "/" & right(tmp(i),len(tmp(i))-3)
		end if
	  next
	  
	  Dim recent, ddiff
	  ddiff = DateDiff("d", dtmPwdLastSet, Now)
	  If (ddiff > intDays) Then
		recent = "FALSE"
	  else
		recent = "TRUE"
	  end if
	  
	  strOut = strOut & strName & "," & dtmPwdLastSet & "," & ddiff & "," & _
				recent & "," & disabled & "," & strTopOU & "," & strOU & ",""" & objRs.Fields("distinguishedName") & """"
	  objRs.MoveNext
	Wend
	if (strOut <> "") Then
	  wfile(strOut)
	end if
	
	Set objComp = Nothing
	Set objRs = Nothing
	Set objDate = Nothing
End Sub

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 bug 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
    Integer8Date = CDate(lngDate)
End Function

sub getTimeBias()
    ' Obtain the local time zone bias from machine registry
    Dim objShell, lngBiasKey
    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
end sub

sub wfile(outtxt)
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    IF objFSO.FileExists(OUT_FILE) Then
        Set objFile = objFSO.OpenTextFile(OUT_FILE, forAPPENDING)
    Else
        Set objFile = objFSO.CreateTextFile(OUT_FILE)
        objFile.Close
        Set objFile = objFSO.OpenTextFile(OUT_FILE, forWRITING)
        'headers
        objFile.Writeline "Hostname,Password Last Set,Day Count,Recent,Disabled?,Top Level OU,OU,Distinguished Name"
    End If
	
    objFile.Writeline outtxt
    objFile.close

end sub