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>