Retrieving Password from Application Pool

I came across an undoc­u­ment­ed app the oth­er day. For a num­ber of rea­sons, we need­ed to restore the pass­word but it wasn’t doc­u­ment­ed any­where. Luck­i­ly, the ser­vice account was set­up in an app pool. In IIS 7.0 or 7.5, APPCMD can be used to recov­er the pass­word. In 6.0, adsutil.vbs can be used.

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

How­ev­er, I want­ed to write my own lit­tle script. Hav­ing a lit­tle tid­bit makes it easy to reuse lat­er for oth­er clients. For exam­ple, I could search AD for SPNs start­ing with “HTTP”, loop through each of their app pools and doc­u­ment the user­name and pass­words for all ser­vice accounts used in this fash­ion. So, here is the lit­tle tid­bit I threw togeth­er.

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 exam­ple of just what I men­tioned above. YMMV but this should dis­cov­er IIS box­es and report all the accounts used in their app pools. Note: Pools using built-in accounts will show up with blank pass­words; this is nor­mal; the pass­word isn’t actu­al­ly 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 = ""
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 & "rootmicrosoftiisv2")
	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