WIN7系统有时候很奇怪,远程桌面一点连接就异常崩溃了,纠结此问题好久,在网上找到这个修复脚本,稍微修改了几个地方。
' ============================================ ' CheckCredSSP.vbs ' ' Verifies that the settings necessary for CredSSP are enabled on XP clients ' As per http://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 ' '远程桌面连接支持网络级身份验证, WIN7 操作系统也可以使用 ' ============================================ 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 "打开值失败: " & strValueName 'WScript.Quit ReDim arrValues(0) arrValues(0) = "tspkg" iError = objReg.SetMultiStringValue( HKEY_LOCAL_MACHINE, strKeyPath, strValueName, arrValues ) If ( iError <> 0 ) Then ' Failed to write the value, exit early WScript.Echo "写入值失败: " & strValueName & vbCrLf & "错误代码: " & iError WScript.Quit End If Else 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 "写入值失败: " & strValueName & vbCrLf & "错误代码: " & iError WScript.Quit End If 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 "打开值失败: " & strValueName 'WScript.Quit 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 "写入值失败: " & strValueName & vbCrLf & "错误代码: " & iError WScript.Quit End If Else ' 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 "写入值失败: " & strValueName & vbCrLf & "错误代码: " & iError WScript.Quit End If 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 & "存在 (已增加)" Else strOutput = strOutput & "存在" End If strOutput = strOutput & vbCrLf & vbCrLf &_ "SecurityProviders - credssp.dll : " If Not bPresent_credssp Then strOutput = strOutput & "存在 (已增加)" Else strOutput = strOutput & "存在" 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 "打开值失败: " & 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
原来是 HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SecurityProviders 下面的 SecurityProviders 值 'credssp.dll' 没有
执行上述脚本后,远程桌面连接上去,正常了。
【另注】
后面发现远程桌面点连接时,还有出现异常崩溃的现象,用下面方法解决了:
新建一个扩展名为 .rdp 的文件,在里面添加一行远程地址信息:
full address:s:192.168.30.48
再双击 rdp 文件,出现连接对话框,点击连接,竟然可以正常连接上去了,Windows 啊,晕到死。。。