Migrating to Windows 7 has thrown up another problem – users wanting to connect from home computers running XP cannot use the Remote Desktop Client to connect to their newly upgraded office PCs. The Network Level Authentication change to the Remote Desktop Client was made because the original RDP is susceptible to Man-in-the-middle attacks.

Rather than leaving the new systems vulnerable by allowing connections from all clients in Computer Propertes > Remote settings, I discovered that Windows XP SP3 does in fact offer NLA support however it’s disabled by default. Somewhat frustratingly, the steps outlined in Microsoft KB 951608 require Registry edits which I would not want to encourage non-IT-savvy people to try. Giving out a .reg file is not really a good idea here either since these are additions to existing values, so forced replacements could interfere with certain vendors’ VPN clients etc.

Here’s a VBScript for the task which will only install on XP SP3 and will detect if the modifications have already been made. You could easily target it at a whole group of PCs by iterating through an array of hostnames.

'Enables Network Level Authentication on XP SP3 (disabled by default)
'which allows you to use the Remote Desktop Client 6.1 to connect to
'Windows 7 and Windows Server 2008 R2 without degrading security

Option Explicit

Const HKEY_LOCAL_MACHINE = &H80000002

Dim strLsaKey, strLsaValue, strHostname, size, arrMultiRegSZ, objReg, objWMI, colItems, i, found, modified
Dim objItem, SPlevel, strOSVer, strSecProvKey, strSecProvValue, strValue

strLsaKey = "SYSTEM\CurrentControlSet\Control\Lsa"
strLsaValue = "Security Packages"
strSecProvKey = "SYSTEM\CurrentControlSet\Control\SecurityProviders"
strSecProvValue = "SecurityProviders"
strHostname = "."
modified = false
found = false

Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strHostname & "\root\cimv2")
Set colItems = objWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each objItem In colItems
  strOSVer = objItem.Version
  SPlevel = objItem.ServicePackMajorVersion
Next
If Not Left(strOSVer,3) = "5.1" Then
  WScript.Echo "This script is only intended for Windows XP."
  WScript.Quit
End If
If Not SPlevel >= 3 Then
  WScript.Echo "Please install the latest Windows XP Service Pack from Windows Update."
  WScript.Quit
End If

Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strHostname & "\root\default:StdRegProv")
objReg.GetMultiStringValue HKEY_LOCAL_MACHINE, strLsaKey, strLsaValue, arrMultiRegSZ
size = Ubound(arrMultiRegSZ)
For i=0 to size
  If arrMultiRegSZ(i) = "tspkg" Then
    found = true
  End If
Next
If found Then
  WScript.Echo "tspkg already added to HKLM\SYSTEM\CurrentControlSet\Control\Lsa"
Else
  ReDim Preserve arrMultiRegSZ(size + 1)
  arrMultiRegSZ(size + 1) = "tspkg"
  objReg.SetMultiStringValue HKEY_LOCAL_MACHINE, strLsaKey, strLsaValue, arrMultiRegSZ
  modified = true
End If

objReg.GetStringValue HKEY_LOCAL_MACHINE, strSecProvKey, strSecProvValue, strValue

If Instr(strValue,"credssp.dll") Then
  WScript.Echo "credssp.dll already added to HKLM\SYSTEM\CurrentControlSet\Control\SecurityProviders"
Else
  strValue = strValue & ", credssp.dll"
  objReg.SetStringValue HKEY_LOCAL_MACHINE, strSecProvKey, strSecProvValue, strValue
  modified = true
End If
If modified Then
  WScript.Echo "Settings updated. You will need to restart for the changes to become active."
End If

Set objReg = nothing
Set objWMI = nothing