Skip navigation

Alright, so Active Directory Asset Management.  What is it?

Well a, not so, unique problem facing every enterprise large or small, is asset management.

Now asset management is not a one dimensional issue, there are requirements and facets to it that shift depending on the person you ask.  From an engineering and maintenance standpoint at my company we have needs of tying important information as closely to the asset as possible, yet removed enough that it’s accessible even when the asset is not.  So what does that mean?

I want to have information tied to the machine but not dependent on the machine.  Something that contains properties that can be modified by the machine, yet retrievable apart from the machine.  Well that’s a relatively simple solution, LDAP, or Active Directory as the case may be.

In this case, my co-worker David Renfrow has opted to utilize the AD Computer Object Description property to store the strings that uniquely identifies our asset.  At present the tool is used to search for specific values in objects, to get/set the string values, and lastly to export findings from the search to a csv report bundled into a single self contained HTA.

image

For the next release I intend to implement error handling, and a potential DB write out function as well as domain search base targeting. At present it only pulls from the Domain of the querying asset, so in a multi domain forest that can be a problem.

Current Version Code Below:


<html>
	<head>
		<title>Active Directory Asset Manager (ADAM)</title>
<!--<description>
	Tool:		Active Directory Asset Manager
	
	Authors: 	David Renfrow, Daniel Belcher 
	
	Tool Info: 	The tools purpose is to retrieve, query, and 
				set system specific information	to a string in 
				the ADO Description property.  This string is 
				specially formatted	to retrieve in a specific way:
				
		<Server>;<Sixdot>;<Purpose>;<Location>;<Domain>;<SLA>;
	<SrvContact>;<SrvManager>;<SGPrimary>;<SGBackup>;<DBAPrimary>;<DBABackup>
				
</description>-->
	<HTA:APPLICATION 
		ID="ADAM" 
		APPLICATIONNAME="ADAM"
		BORDER="thin"
		SINGLEINSTANCE="yes"
	>

<SCRIPT LANGUAGE="VBScript">
'-----------Application Initialization-----------------------------------------
'On Error Resume Next
Dim oConn, oCmd, item, oComputer, strDomain, Dict

Sub Window_onLoad
	window.resizeTo 625,725
	
	Set oConn = CreateObject("ADODB.Connection")
		oConn.Provider = "ADsDSOObject"
	Set oCmd =  CreateObject("ADODB.Command")
	Set Dict = New cls_Dict

	strDomain = Dict.DistinguishedDomainName
	
	
End Sub 
'----------------Controls------------------------------------------------------
Sub getproc()
	On Error Resume Next

	strComputer = ServerName.Value
	ADLookUp(strComputer)
	Description = oComputer.Get("Description")
	If Err.Number <> 0 Then
		Err.Clear
		Description = ";;;;;;;;;;;"
	End If
	strOut = Split(Description,";")

	DataArea.innerHtml =	"<table border=""""1"""">" & "<tr>" & _
		"<td>Server</td>"&"<td>"&UCase(strComputer)& "</td>" & "</tr><tr>" & _
		"<td>SixDot</td><td>"&strOut(1) & "</td>" & "</tr><tr>" & _
		"<td>Purpose</td><td>"&strOut(2) & "</td>" & "</tr><tr>" & _
		"<td>Location</td><td>"&strOut(3) & "</td>" & "</tr><tr>" & _
		"<td>Domain</td><td>"&strOut(4) & "</td>" & "</tr><tr>" & _
		"<td>SLA</td><td>"&strOut(5) & "</td>" & "</tr><tr>" & _
		"<td>Srv Contact</td><td>"&strOut(6) & "</td>" & "</tr><tr>" & _
		"<td>Srv Manager</td><td>"&strOut(7) & "</td>" & "</tr><tr>" & _
		"<td>SG Primary</td><td>"&strOut(8) & "</td>" & "</tr><tr>" & _
		"<td>SG Backup</td><td>"&strOut(9) & "</td>" & "</tr><tr>" & _
		"<td>DBA Primary</td><td>"&strOut(10) & "</td>" & "</tr><tr>" & _
		"<td>DBA Backup</td><td>"&strOut(11) & "</td>" & "</tr><tr>" & _
		"<td>Last Updated</td><td>"&strOut(12) & "</tr></table>"
			
	servername.value = UCase(strComputer)
	sixdot.value = strOut(1)
	purpose.value = strOut(2)
	loc.value = strOut(3)
	domain.value = strOut(4)
	sla.value = strOut(5)
	srvcontact.value = strOut(6)
	srvmanager.value = strOut(7)
	sgprimary.value = strOut(8)
	sgbackup.value = strOut(9)
	dbaprimary.value = strOut(10)
	dbabackup.value = strOut(11)

	oConn.Close
End Sub

Sub setproc()
	strComputer = ServerName.Value
	ADLookUp(strComputer)
	if sixdot.value = "" then sixdot.value = "NA"
	if purpose.value = "" then purpose.value = "NA"
	if loc.value = "" then loc.value = "NA"
	if domain.value = "" then domain.value = "NA"
	if sla.value = "" then sla.value = "NA"
	if srvcontact.value = "" then srvcontact.value = "NA"
	if srvmanager.value = "" then srvmanager.value = "NA"
	if sgprimary.value = "" then sgprimary.value = "NA"
	if sgbackup.value = "" then sgbackup.value = "NA"
	if dbaprimary.value = "" then dbaprimary.value = "NA"
	if dbabackup.value = "" then dbabackup.value = "NA"
	oComputer.Put "Description", servername.value&";"&sixdot.value&";"& _
			purpose.value&";"&loc.value&";"&domain.value&";"&SLA.value&";"& _
			srvcontact.value&";"&srvmanager.value&";"&sgprimary.value&";"& _
			sgbackup.value&";"&dbaprimary.value&";"&dbabackup.value&";"&date
	oComputer.SetInfo
	oConn.Close
End Sub

Sub clearproc
	dataarea.InnerHTML = ""
	servername.value = ""
	srvcontact.value = ""
	sixdot.value = ""
	srvmanager.value = ""
	purpose.value = ""
	sgprimary.value = ""
	loc.value = ""
	sgbackup.value = ""
	domain.value = ""
	dbaprimary.value = ""
	sla.value = ""
	dbabackup.value = ""
End Sub

Sub searchproc()

	If Dict.Exists("ADRecords") Then
		Dict.Remove("ADRecords")
	End If
	
	msg = Null
	
	Call ADSearch(search.value)
	For Each item In Dict.ReturnArray("ADRecords")
		temp = Split(item,"|x|")	
		msg = msg &"<b>Name:</b><em> " & UCase(temp(0)) & "</em><br>" _
				& "<b>Description:</b><em> " & temp(1) & "</em><br><br>"
	Next
	
	dataarea.innerhtml = "<input type="&Chr(34)&"button"&Chr(34)&" value="& _
	Chr(34)& "Export to CSV"&Chr(34)&" onclick="&Chr(34)&"export"&Chr(34)& _
	"/><br>" & msg
	
End Sub

Sub export()

	Dim oFso, FileHandle
	Set oFso = CreateObject("Scripting.FileSystemObject")
	temp = Split(Date,"/")
	sDate = temp(0)&temp(1)&temp(2)
		
	Set FileHandle = oFso.OpenTextFile _
		(Dict.CurrentDir&"ServerOut-"&sDate&".csv", 2, True)
		FileHandle.WriteLine "Server,SIXDOT,Purpose,Location,Domain,SLA," & _
"Srv Contact,Srv Manager,SG Primary,SG Backup,DBA Primary,DBA Backup,Modified"
		
		For Each item In Dict.ReturnArray("AdRecords")
			temp = Split(item,"|x|")
			strWrite = Replace(temp(1),",","-")
				strWrite = Replace(strWrite,";",",")
					strWrite = Replace(strWrite,"-",";")
			FileHandle.WriteLine strWrite
		Next
	FileHandle.Close
	
	dataarea.innerhtml = "<p>Report written to:<br>" & _
					"<em>"&Dict.CurrentDir&"serverout-"&sDate&".csv</em></p>"
End Sub

'-----------------Working Functions--------------------------------------------
Public Function ADLookUp(strComputer)

	oConn.Open "Active Directory Provider"
	Set oCmd.ActiveConnection = oConn
	oCmd.CommandText = _
		"Select * from 'LDAP://"&strDomain&"' " _
        & "Where objectCategory='computer' AND name = '"& strComputer &"'" 
	oCmd.Properties("searchscope") = 2
	oCmd.Properties("Page Size") = 1000
	Set oRecord = oCmd.Execute

	For Each item In oRecord.Fields
		Set oComputer = GetObject(item)
	Next
End Function

Public Function ADSearch(strProperty)

	oConn.Open "Active Directory Provider"
	Set oCmd.ActiveConnection = oConn
	oCmd.CommandText = "Select Name, Description, DistinguishedName from " &_
	"'LDAP://"&strDomain&"' Where objectCategory='computer'" 
	oCmd.Properties("Page Size") = 1000
	oCmd.Properties("searchscope") = 2
	Set oRecord = oCmd.Execute
	oRecord.MoveFirst
	
	Do Until oRecord.EOF
	On Error Resume Next 
		Set oComputer = GetObject _
		("LDAP://" & orecord.Fields("distinguishedName").value)
			Description = oComputer.Get("Description")
			If InStr(1,LCase(Description), LCase(strProperty)) <> 0 Then
				Call Dict.ItemList("ADRecords",orecord.Fields("name").value& _
				"|x|" & Description)
			End If
		Description = Null
		oRecord.MoveNext
	Loop
	oConn.Close
End Function
'----------------Class Objects-------------------------------------------------

Class cls_Dict
'Class wrapper for the scripting.dictionary
	Private oDict, oNet, Comparemode, strSplit, oFso, oWShell, oADSI

'---------------------------------------------------------

Private Sub Class_Initialize()
'Dictionary class init subroutine    
    If Debugmode Then On Error Goto 0 Else On Error Resume Next
		Set oDict 	= CreateObject("Scripting.Dictionary")
		Set oNet	= CreateObject("Wscript.Network")
		Set oFso	= CreateObject("Scripting.FileSystemObject")
		Set oWShell = CreateObject("Wscript.Shell")
		Set oADSI = CreateObject("ADSystemInfo")
		
		Dim strUserDomain : strUserDomain = oADSI.DomainDNSName
		Dim strDomain : strDomain = Split(strUserDomain,".")
		For Each item In strDomain
			strDNDomain = strDNDomain & "DC="&item&","
		Next
		oDict.CompareMode = 1
			strSplit = "|:|"
		Call oDict.Add("CurrentDir",oWShell.CurrentDirectory&"")
		Call oDict.Add("computername", oNet.Computername)
		Call oDict.Add("Windir",LCase(oWShell.ExpandEnvironmentStrings _
			("%windir%")))
		Call oDict.Add("CurrentUser",LCase(oNet.UserName))
		Call oDict.Add("Domain",LCase(oNet.UserDomain))
		Call oDict.Add("DomainDN",Left(strDNDomain,(Len(strDNDomain)-1)))
		Call SetOsVer
End Sub

'---------------------------------------------------------

Private Sub Class_Terminate()
'Dictionary class termination subroutine
	If IsObject(oDict) then Set oDict = Nothing
End Sub

'---------------------------------------------------------

Public Property Get CurrentDir
'Returns Current Directory for the script
	CurrentDir = oDict.Item("CurrentDir")
End Property

'---------------------------------------------------------

Public Property Get ComputerName
'Returns the machine name for the current machine
	ComputerName = oDict.Item("computername")
End Property

'---------------------------------------------------------

Public Property Get CurrentUser
'Returns the machine name for the current machine
	CurrentUser = oDict.Item("CurrentUser")
End Property

'---------------------------------------------------------

Public Property Get Domain
'Returns the machine name for the current machine
	Domain = oDict.Item("Domain")
End Property

'---------------------------------------------------------

Public Property Get DistinguishedDomainName
'Returns the Distinguished Name for the Domain
	DistinguishedDomainName = oDict.Item("DomainDN")
End Property

Public Property Get Windir
'Returns the windows directory for the local machine
	Windir = oDict.Item("windir")
End Property

Public Property Get SystemRoot
'Returns the appropriate system directory system32 or syswow64

	If InStr(StrReverse(oDict.Item("CurrentOsVer")), "46x") <> 0 Then 
		SystemRoot = Windir & "syswow64"
	Else
		SystemRoot = Windir & "system32"
	End If

End Property
'---------------------------------------------------------

Public Sub Add(strKey,strValue)
'Method to Add a key and item
	If Debugmode Then On Error Goto 0 Else On Error Resume Next

    Dim EnvVariable, strSplit

    	strSplit = Split(strValue, "%")
	If IsArray(strSplit) Then 
    	EnvVariable = oWShell.ExpandEnvironmentStrings _
    		("%" & strSplit(1) & "%")
    	strValue = strSplit(0) & EnvVariable & strSplit(2)
    			If strValue = "" Then
    				strValue = strSplit(0)
    			End If
    End If
	If oDict.Exists(strKey) Then
		oDict(strKey) = Trim(strValue)
	Else
		oDict.Add strKey, Trim(strValue)
	End If
End Sub

'---------------------------------------------------------

Public Function Exists( strkey)
'Method to check existance of a key
    If Debugmode Then On Error Goto 0 Else On Error Resume Next
	
	If oDict.Exists(strKey) then 
		Exists = True
	Else
		Exists = False
	End If

End Function

'---------------------------------------------------------

Public Function Keys()
'Method to retrieve an array of keys
    If Debugmode Then On Error Goto 0 Else On Error Resume Next

	If IsObject(oDict) Then
		Keys = oDict.Keys
	End If
End Function

'---------------------------------------------------------

Public Function Items()
'Method to retrieve an array of items
    If Debugmode Then On Error Goto 0 Else On Error Resume Next

	If IsObject(oDict) Then
		Items = oDict.Items
	End If
End Function

'---------------------------------------------------------
Private Sub SetOsVer()
'Sets a comparable OSVer key item into the dictionary
		If DebugMode Then On Error Goto 0 Else On Error Resume Next

		Dim x, VersionCheck	
		
	VersionCheck = owShell.RegRead("HKLMsoftwaremicrosoft" _
					& "windows ntcurrentversionproductname")

			If ofso.folderexists("c:windowssyswow64") Then
				x = "x64"
			Else
				x = "x86"
			End If
		Call oDict.Add("CurrentOsVer",VersionCheck & " " & x)
End Sub
	Public Property Get OsVer()
		OsVer = oDict.Item("CurrentOsVer")
	End Property

'---------------------------------------------------------
Public Property Get AppName()

	AppName = Left(WScript.ScriptName, Len(WScript.ScriptName) - 4)
End Property 

'---------------------------------------------------------

Public Property Get Key( strKey)
'Property to retrieve item value from specific key
    If Debugmode Then On Error Goto 0 Else On Error Resume Next

		Key = Empty
	If IsObject(oDict) Then
		If oDict.Exists(strKey) Then Key = oDict.Item(strKey)
	End If
End Property

'---------------------------------------------------------

Public Sub ItemJoin(strKey, strItem)
'Method to concactenate new items under one key at the end of the string
    If Debugmode Then On Error Goto 0 Else On Error Resume Next
	Dim concat
	If Not oDict.Exists(strKey) Then
		Call oDict.Add(strkey, stritem)
	Else
		concat = oDict.Item(strKey)
		concat = concat & " " & strItem
			oDict.Remove(strKey)
		Call oDict.Add(strKey,concat)
	End If
End Sub

'---------------------------------------------------------

Public Sub ItemList( strKey,  strItem)
'Method to concactenate new items under one key at the end of the string
    If Debugmode Then On Error Goto 0 Else On Error Resume Next
	Dim concat
	If Not oDict.Exists(strKey) Then
		Call oDict.Add(strkey, stritem)
	Else
		concat = oDict.Item(strKey)
		concat = concat & "|:|" & strItem
			oDict.Remove(strKey)
		Call oDict.Add(strKey,concat)
	End If
End Sub

'---------------------------------------------------------

Public Sub ItemJoinRev( strKey,  strItem)
'Method to concactenate new items under one key at the start of the string
    If Debugmode Then On Error Goto 0 Else On Error Resume Next
	Dim concat
	If Not oDict.Exists(strKey) Then
		Call oDict.Add(strkey, stritem)
		Exit Sub
	Else
		concat = oDict.Item(strKey)
		concat = strItem & " " & concat
			oDict.Remove(strKey)
		Call oDict.Add(strKey,concat)
	End If
End Sub
	
'---------------------------------------------------------	

Public Function ReturnArray( strKey)
'Method to return an item as an array
    If Debugmode Then On Error Goto 0 Else On Error Resume Next
	
	Dim ItemToSplit, ItemArray
	
	ItemToSplit = oDict.item(strKey)
	
	ItemArray = Split(ItemToSplit, strSplit)
	
	ReturnArray = ItemArray	
	
End Function
	
'---------------------------------------------------------	

Public Sub Remove( strKey)
'Method to remove a key value
	oDict.Remove(strKey)
End Sub

'---------------------------------------------------------

Public Sub RemoveAll()
'Method to remove all data from the dictionary
	oDict.RemoveAll
End Sub

End Class
'------------------------------------------------------------------------------
</script>

<body bgcolor="silver">
	<table>
	<tr>
	<td>Server</td><td><input type="text" name="servername" size="30"></td>
	<td>Srv Contact</td><td><input type="text" name="srvcontact" size="30"></td>
	</tr>
	<tr>
	<td>SIXDOT</td><td><input type="text" name="sixdot" size="30"></td>
	<td>Srv Manager</td><td><input type="text" name="srvmanager" size="30"></td>
	</tr>
	<tr>
	<td>Purpose</td><td><input type="text" name="purpose" size="30"></td>
	<td>SG Primary</td><td><input type="text" name="sgprimary" size="30"></td>
	</tr>
	<tr>
	<td>Location</td><td><input type="text" name="loc" size="30"></td>
	<td>SG Backup</td><td><input type="text" name="sgbackup" size="30"></td>
	</tr>
	<tr>
	<td>Domain</td><td><input type="text" name="domain" size="30"></td>
	<td>DBA Primary</td><td><input type="text" name="dbaprimary" size="30"></td>
	</tr>
	<tr>
	<td>SLA</td><td><input type="text" name="sla" size="30"></td>
	<td>DBA Backup</td><td><input type="text" name="dbabackup" size="30"></td>
	</tr>
	</table>
	<p>
	<input type="button" value="Get" onclick="getproc"/>
	<input type="button" value="Set" onclick="setproc"/>
	<input type="button" value="Clear" onclick="clearproc"/>
	<input type="button" value="Search" onclick="searchproc"/>
	<input type="text" value="keyword" name="search">
	</p>
	<hr>
	<div id = "DataArea"></div>
</body>

</html>

Leave a Reply