' This script takes two optional parameters
' One is the DN of a folder to restrict the report to  (e.g. PDReports.vbs CN=Computers,DC=test,DC=com)
' The other is a servername:port for an ADAM instance to get objects from, instead of AD (e.g. PDReports.vbs ADAMServer:50000)
' These two command line parameters can be placed in any order

Dim sDomainString
Dim sFinalResult
Dim sADAMLocation
'The following checks the arguments and sets them appropriately. It assumes that both are inputted correctly, if they aren't the script will fail at some later point.
If WScript.Arguments.Count = 1 Then
	sColonInPlace = InStr(WScript.Arguments(0), ":")
	If sColonInPlace = 0 Then
		sDomainString = WScript.Arguments(0)
	Else
		sADAMLocation = WScript.Arguments(0)
	End If
ElseIf WScript.Arguments.Count = 2 Then
	sColonInPlace = InStr(WScript.Arguments(0), ":")
	If sColonInPlace = 0 Then
		sDomainString = WScript.Arguments(0)
		sADAMLocation = WScript.Arguments(1)
	Else
		sDomainString = WScript.Arguments(1)
		sADAMLocation = WScript.Arguments(0)
	End If
End If

'If we didn't find a specific DN to get in the command line then just grab the root of AD
If sDomainString = "" Then
	set oRootDSE = GetObject("LDAP://RootDSE")
	sDomainString = oRootDSE.Get("defaultNamingContext")
	set oRootDSE = Nothing
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
currentDir = Left(Wscript.ScriptFullName,Len(Wscript.ScriptFullName) - Len(Wscript.ScriptName))
Set objFile = objFSO.CreateTextFile(currentDir & "PDReport.csv")
objFile.WriteLine "ComputerName,PDStatus,LastUpdate(UTC),EncryptedDrives"

'Get a handle to the given DN
Set objActiveDirectory = GetObject("LDAP://" & sDomainString)
'Recurse through all the objects in the given DN
GetObjects objActiveDirectory
Sub GetObjects(tempFolder)
	For each objAD in tempFolder
		GetandWriteData objAD.distinguishedName
		GetObjects objAD
	Next
End Sub

Sub GetandWriteData(sFolder)
	'Parse the sFolder string and add any escape characters that are need for the LDAP command
	AddEscapeChar sFolder
	'Filter and get all the computer name
	Set objActiveDirectory = GetObject("LDAP://" & sFolder)
	
	objActiveDirectory.Filter = Array("computer")
	
	For Each objComputer In objActiveDirectory
		sFinalResult = ""
		'Grab the computer's name
		Set objActDir = GetObject("LDAP://" & objComputer.Name & "," & sFolder)
		On error resume next
		sFinalResult = Right(objComputer.Name,Len(objComputer.Name) - Len("CN=")) & ","
		'If ADAM is being used we no longer need the AD reference in this loop, replace it with the ADAM reference
		If sADAMLocation <> "" Then
			sCompSid = SIDArray(objActDir.Get("objectSid"))
			Set objActDir = GetObject("LDAP://" & sADAMLocation & "/" & "CN=" & sCompSid & ",CN=Computers,CN=PDPartition")
		End If
		'Grab the computer's Update Status
		sUpdateStatus = objActDir.Get("eracomPdClientUpdateStatusCodeV1")
		If Err.Number = 0 and sUpdateStatus = 0 Then
			sFinalResult = sFinalResult & "Active,"
		Else
			sFinalResult = sFinalResult & "Inactive,"
		End If
		'Grab the computer's last update time (returned in GMT)
		sUpdateTime = objActDir.Get("eracomPdClientUpdateTimeV1")
		If Err.Number = 0 Then
			sFinalResult = sFinalResult & sUpdateTime & ","
		End If
		'Check if any of the drives are encrypted
		sEncryptState = objActDir.Get("eracomPdEncryptionStatusV1")
		If Err.Number = 0 Then
			DriverLetter = Array("C:", "D:", "E:", "F:", "G:", "H:", "I:", "J:", "K:", _
					"L:", "M:", "N:", "O:", "P:", "Q:", "R:", "S:", "T:", "U:", _
					"V:", "W:", "X:", "Y:", "Z:")
			For j=1 to LenB(sEncryptState)
				strByte = AscB(MidB(sEncryptState,j,1))
				If strByte <> 128 and strByte <> 0 Then
					sFinalResult = sFinalResult & DriverLetter(j-1) & " "
				End If
			Next
		End If
		objFile.WriteLine sFinalResult
	Next
End Sub

'This function parses the string and adds escape characters where needed for LDAP commands (Currently only looks for "/")
Sub AddEscapeChar(ldapString)
	dim pos,finalString,searchString
	searchString = ldapString
	pos = InStr(ldapString, "/")
	Do Until pos = 0
		finalString = finalString & Left(searchString, pos - 1) & "\" & "/"
		searchString = Right(searchString, Len(searchString) - pos)
		pos = InStr(searchString, "/")
	Loop
	ldapString = finalString & searchString
End Sub

'Following two functions are from http://www.scottlocke.net
Function SIDArray(bar)
	' Converts Binary Array into Human readable eg: S-1-5-21-XXXXX-XXXXX-XXXXX-XXX
	dim seperator,sid,length
	seperator = ""
	sid = ""
	for length = 1 to lenb(bar)
		sid = sid & seperator & right("0" & hex(ascb(midb(bar,length,1))),2)
		seperator = ","
	Next
	SIDArray = sid
	SID = Split(SIDArray,",")

	' Convert into standard viewable format - little endian format for 4 byte groups
	SID1 = (HexToDec(Mid(SID(15), 1, 1))*268435456) + (HexToDec(Mid(SID(15), 2, 2))*16777216) + (HexToDec(Mid(SID(14), 1, 1))*1048576) + (HexToDec(Mid(SID(14), 2, 2))*65536) + (HexToDec(Mid(SID(13), 1, 1))*4096) + (HexToDec(Mid(SID(13), 2, 2))*256) + (HexToDec(Mid(SID(12), 1, 1))*16) + HexToDec(Mid(SID(12), 2, 2))
	SID2 = (HexToDec(Mid(SID(19), 1, 1))*268435456) + (HexToDec(Mid(SID(19), 2, 2))*16777216) + (HexToDec(Mid(SID(18), 1, 1))*1048576) + (HexToDec(Mid(SID(18), 2, 2))*65536) + (HexToDec(Mid(SID(17), 1, 1))*4096) + (HexToDec(Mid(SID(17), 2, 2))*256) + (HexToDec(Mid(SID(16), 1, 1))*16) + HexToDec(Mid(SID(16), 2, 2))
	SID3 = (HexToDec(Mid(SID(23), 1, 1))*268435456) + (HexToDec(Mid(SID(23), 2, 2))*16777216) + (HexToDec(Mid(SID(22), 1, 1))*1048576) + (HexToDec(Mid(SID(22), 2, 2))*65536) + (HexToDec(Mid(SID(21), 1, 1))*4096) + (HexToDec(Mid(SID(21), 2, 2))*256) + (HexToDec(Mid(SID(20), 1, 1))*16) + HexToDec(Mid(SID(20), 2, 2))
	RID = (HexToDec(Mid(SID(27), 1, 1))*268435456) + (HexToDec(Mid(SID(27), 2, 2))*16777216) + (HexToDec(Mid(SID(26), 1, 1))*1048576) + (HexToDec(Mid(SID(26), 2, 2))*65536) + (HexToDec(Mid(SID(25), 1, 1))*4096) + (HexToDec(Mid(SID(25), 2, 2))*256) + (HexToDec(Mid(SID(24), 1, 1))*16) + HexToDec(Mid(SID(24), 2, 2))

	' Cheating here by just prepending the S-1-5-21-
	SIDArray = "S-1-5-21-" & SID1 & "-" & SID2 & "-" & SID3 & "-" & RID
End Function 

Function HexToDec(ByVal sHex)
	HexToDec = "" & CLng("&H" & sHex)
End Function 
