I came across an undocumented app the other day. For a number of reasons, we needed to restore the password but it wasn’t documented anywhere. Luckily, the service account was setup in an app pool. In IIS 7.0 or 7.5, APPCMD can be used to recover the password. In 6.0, adsutil.vbs can be used.

cscript.exe /nologo adsutil.vbs GET W3SVC/AppPools/AppPoolName/WAMUserPass

However, I wanted to write my own little script. Having a little tidbit makes it easy to reuse later for other clients. For example, I could search AD for SPNs starting with “HTTP”, loop through each of their app pools and document the username and passwords for all service accounts used in this fashion. So, here is the little tidbit I threw together.

Option Explicit
 
Call GetAppPoolUserAndPass("localhost", "ApplicationPoolName")
 
Private Sub GetAppPoolUserAndPass (byVal strComputer, byVal strAppPool)
	Dim appPool
	On Error Resume Next
	Set appPool = GetObject("IIS://" & strComputer & "/w3svc/AppPools/" & strAppPool)
	If Err Then
		wscript.echo "Error connecting to " & chr(34) & strAppPool & chr(34) & " on " & strComputer
	Else
		wscript.echo strAppPool & vbTab & appPool.WAMUserName & vbTab & appPool.WAMUserPass
	End If
	On Error GoTo 0
End Sub

Here is an example of just what I mentioned above. YMMV but this should discover IIS boxes and report all the accounts used in their app pools. Note: Pools using built-in accounts will show up with blank passwords; this is normal; the password isn’t actually blank.

Option Explicit
 
' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
 
' Determine DNS domain name.
Dim objRootDSE, strDNSDomain
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
 
' Use ADO to search Active Directory.
Dim adoCommand, adoConnection
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
 
' Build Query
Dim strBase, strFilter, strAttributes, strQuery
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(servicePrincipalName=HTTP*)" 'Search for SPN starting w/ HTTP (case insensitive)
strAttributes = "name"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
 
Dim adoRecordset
Set adoRecordset = adoCommand.Execute
 
If (adoRecordset.EOF = True) Then
    Wscript.Echo "No SPNs Found matching HTTP*"
    Wscript.Quit
End If
 
Wscript.Echo "Computer Name" & vbTab & "AppPool Name" & vbTab & "User Name" & vbTab & "User Password"
 
Do Until adoRecordset.EOF
    Call GetApplicationPools(adoRecordset.Fields("name").Value & "." & strDNSDomain)
    adoRecordset.MoveNext
Loop
adoRecordset.Close
 
' Clean up.
adoConnection.Close
 
Private Sub GetApplicationPools (byVal strComputer)
	Dim objWMIService, colItems, objItem
 
	On Error Resume Next
	Set objWMIService = GetObject("winmgmts:{authenticationLevel=pktPrivacy}\\" & strComputer & "\root\microsoftiisv2")
	Set colItems = objWMIService.ExecQuery("Select * from IIsApplicationPoolSetting")
	If Err Then
		wscript.echo "Error connecting to " & strComputer
	Else
		For Each objItem in colItems
			Wscript.Echo strComputer & vbTab & objItem.Name & vbTab & objItem.WAMUserName & vbTab & objItem.WAMUserPass
		Next
	End If
End Sub