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.
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>