Enabling CredSSP on XP SP3 clients via script

Following on from my previous blog entry, while the manual method is simple enough, and we could just import a .REG file to force “Security Packages” and “SecurityProviders” to fixed values, it would be more elegant to have a smarter solution that will make the amendments if necessary.

So here is a VBScript to check if “tspkg” is in “Security Packages” and “credssp.dll” is in “SecurityProviders”, and add them if not.
It also reports on the status of the GPO settings affecting DisableRootAutoUpdate and CredentialsDelegation (default and saved), but does not attempt to adjust these as they should be done via GPO rather than registry edits.

Use this script at your own risk – I’ve tested it very briefly but there is no error checking or backing up of the keys/values performed, and it does not attempt to verify the OS version is applicable.

If double-clicked then wscript.exe is used by default and the result is displayed in a pop-up window – if it needs to be run in a computer startup script then make sure to explicitly use cscript.exe (and optionally pipe the output to a log file if needed).

' ============================================
' CheckCredSSP.vbs
'
' Verifies that the settings necessary for CredSSP are enabled on XP clients
' As per https://support.microsoft.com/kb/951608
'
' Checks if DisableRootAutoUpdate policy setting is enabled to avoid a 30-second
' delay when clients have no access to Windows Update and NLA is used
'
' Displays a summary of any credential delegation policy settings found
' ============================================
const HKEY_LOCAL_MACHINE = &H80000002
const REG_SZ = 1
strComputer = "."

' Variables to hold results of key enumeration and the value types
arrNames = Array()
arrTypes = Array()

' Variables to hold values for REG_MULTI_SZ, REG_SZ and REG_DWORD data
arrValues = Array()
strValue = ""
dwValue = 0

' Object to allow us access to the registry
Set objReg=GetObject( _
"winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")

' ============================================
' Check for (and add if necessary) tspkg in REG_MULTI_SZ value
' ============================================
strKeyPath = "SYSTEM\CurrentControlSet\Control\Lsa"
strValueName = "Security Packages"
bPresent_tspkg = FALSE

If ( objReg.GetMultiStringValue( HKEY_LOCAL_MACHINE, strKeyPath, strValueName, arrValues ) <> 0 ) Then
' Failed to read the value, exit early
WScript.Echo "ERROR - Failed to open value: " & strValueName
WScript.Quit
End If

For Each strElement in arrValues
If strElement = "tspkg" Then bPresent_tspkg = TRUE
Next

If Not bPresent_tspkg Then
ReDim Preserve arrValues( UBound( arrValues ) + 1 )
arrValues( UBound( arrValues ) ) = "tspkg"
iError = objReg.SetMultiStringValue( HKEY_LOCAL_MACHINE, strKeyPath, strValueName, arrValues )
If ( iError <> 0 ) Then
' Failed to write the value, exit early
WScript.Echo "ERROR - Failed to write value: " & strValueName & vbCrLf & "Error code: " & iError
WScript.Quit
End If
End If

' ============================================
' Check for (and add if necessary) credssp.dll in REG_SZ value
' ============================================
strKeyPath = "SYSTEM\CurrentControlSet\Control\SecurityProviders"
strValueName = "SecurityProviders"
bPresent_credssp = FALSE

If ( objReg.GetStringValue( HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue ) <> 0 ) Then
' Failed to read the value, exit early
WScript.Echo "ERROR - Failed to open value: " & strValueName
WScript.Quit
End If

' Convert the comma-separated string into an array of strings to check each element
arrValues = ConvertStrToArr( strValue )
For Each strElement in arrValues
' We use LTrim() to ignore leading spaces (i.e. spaces after commas)
If LTrim( strElement ) = "credssp.dll" Then bPresent_credssp = TRUE
Next

If Not bPresent_credssp Then
If ( strValue <> "" ) Then strValue = strValue & ", "
strValue = strValue & "credssp.dll"
iError = objReg.SetStringValue( HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue )
If ( iError <> 0 ) Then
' Failed to write the value, exit early
WScript.Echo "ERROR - Failed to write value: " & strValueName & vbCrLf & "Error code: " & iError
WScript.Quit
End If
End If

' ============================================
' Check for DisableRootAutoUpdate = 1
' ============================================
strKeyPath = "SOFTWARE\Policies\Microsoft\SystemCertificates\AuthRoot"
strValueName = "DisableRootAutoUpdate"

strPolicyOutput = vbCrLf & vbCrLf &_
"DisableRootAutoUpdate policy setting "

' Does the value exist and is non-zero?
If ( objReg.GetDWORDValue( HKEY_LOCAL_MACHINE, strKeyPath, strValueName, dwValue ) = 0 ) Then
If ( dwValue <> 0 ) Then
strPolicyOutput = strPolicyOutput & "found : ENABLED" & vbCrLf & vbCrLf
Else
strPolicyOutput = strPolicyOutput & "found : DISABLED" & vbCrLf & vbCrLf
End If
Else
strPolicyOutput = strPolicyOutput & "NOT found" & vbCrLf &_
"Consider enabling the following policy setting if hitting a ~30 second delay:" & vbCrLf &_
"Administrative Templates > System > Internet Communication Management > Internet Communication Settings" & vbCrLf &_
"Turn off Automatic Root Certificates Update" & vbCrLf & vbCrLf
End If

' ============================================
' Check for any policy settings relating to credential delegation
' ============================================
strKeyPath = "SOFTWARE\Policies\Microsoft\Windows\CredentialsDelegation"

If ( objReg.EnumValues( HKEY_LOCAL_MACHINE, strKeyPath, arrNames, arrTypes ) <> 0 ) Then
strPolicyOutput = strPolicyOutput & "Found no credential delegation policy settings (e.g. SSO, saved credentials)" & vbCrLf &_
"Recommend reading KB951608 if SSO is required." & vbCrLf &_
"Or check under:" & vbCrLf &_
"Administrative Templates > System > Credentials Delegation" & vbCrLf
Else
strPolicyOutput = strPolicyOutput & "Found credential delegation policy settings..." & vbCrLf

  strPolicyCheck = CheckPolicy( "DenyDefaultCredentials" )
If ( strPolicyCheck = "" ) Then
strPolicyCheck = CheckPolicy( "AllowDefaultCredentials" )
strPolicyCheck = strPolicyCheck & CheckPolicy( "AllowDefCredentialsWhenNTLMOnly" )
Else
strPolicyOutput = strPolicyOutput & vbCrLf & "DEFAULT credential delegation (SSO) explicitly DENIED by policy" & vbCrLf
End If
strPolicyOutput = strPolicyOutput & strPolicyCheck

  strPolicyCheck = CheckPolicy( "DenySavedCredentials" )
If ( strPolicyCheck = "" ) Then
strPolicyCheck = CheckPolicy( "AllowSavedCredentials" )
strPolicyCheck = strPolicyCheck & CheckPolicy( "AllowSavedCredentialsWhenNTLMOnly" )
Else
strPolicyOutput = strPolicyOutput & vbCrLf & "SAVED credential delegation explicitly DENIED by policy" & vbCrLf
End If
strPolicyOutput = strPolicyOutput & strPolicyCheck
End If

' ============================================
' Display summary of actions
' ============================================
strOutput = "Security Packages - tspkg : "

If Not bPresent_tspkg Then
strOutput = strOutput & "PRESENT (added)"
Else
strOutput = strOutput & "PRESENT"
End If

strOutput = strOutput & vbCrLf & vbCrLf &_
"SecurityProviders - credssp.dll : "

If Not bPresent_credssp Then
strOutput = strOutput & "PRESENT (added)"
Else
strOutput = strOutput & "PRESENT"
End If

WScript.Echo strOutput & strPolicyOutput

' ============================================
' Function to convert a comma-separated string into an array of strings
' ============================================
Function ConvertStrToArr ( strInput )
Set objRegExp = CreateObject( "VBScript.RegExp" )
objRegExp.IgnoreCase = TRUE
objRegExp.Global = TRUE
objRegExp.Pattern = ",(?=([^']*'[^']*')*(?![^']*'))"
ConvertStrToArr = Split( objRegExp.Replace(strInput, "\b"), "\b" )
End Function

' ============================================
' Function to check for a credential delegation policy setting
' ============================================
Function CheckPolicy ( strPolicy )
dwValue = 0
If ( objReg.GetDWORDValue( HKEY_LOCAL_MACHINE, strKeyPath, strPolicy, dwValue ) = 0 ) Then
CheckPolicy = strPolicy & " = " & dwValue
If ( dwValue <> 0 ) Then
CheckPolicy = CheckPolicy & " (ENABLED)" & vbCrLf
If ( objReg.EnumValues( HKEY_LOCAL_MACHINE, strKeyPath & "\" & strPolicy, arrNames, arrTypes ) = 0 ) Then
If IsArray( arrNames ) Then
For i = 0 To UBound( arrNames )
If ( arrTypes( i ) = REG_SZ ) Then
If ( objReg.GetStringValue( HKEY_LOCAL_MACHINE, strKeyPath & "\" & strPolicy, arrNames( i ), strValue ) <> 0 ) Then
' Failed to read the value, exit early
WScript.Echo "ERROR - Failed to open value: " & arrNames( i )
WScript.Quit
End If
CheckPolicy = CheckPolicy & " > " & strValue & vbCrLf
End If
Next
Else
CheckPolicy = CheckPolicy & " > [no SPNs specified]" & vbCrLf
End If
Else
CheckPolicy = CheckPolicy & " > [no SPNs specified]" & vbCrLf
End If
Else
CheckPolicy = CheckPolicy & " (DISABLED)" & vbCrLf
End If
End If
End Function