VBScript で8kバイト以上のレジストリキーを捜す

Windows 7のイメージ配信でトラブルがあったので。
8kB 以上のレジストリキーがあるとイメージ配信に失敗するそうで、該当のレジストリキーを検索するスクリプトです。
見つからなかったら、今までスキャンした中で一番長いキーのみ表示します。

find8kreg.vbs

Option Explicit

Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003

Dim objReg
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

Dim maxLen, maxLine
maxLen = 0
maxLine = ""
Call Find8kKey(HKEY_LOCAL_MACHINE, "")
Call Find8kKey(HKEY_USERS, "")
WScript.Echo "Key Max Size:"&vbTab&maxLen
WScript.Echo "Max Size Key:"&vbTab&maxLine
WScript.Echo "Scan Complete."

Sub Find8kKey(hDefKey, sSubKeyName)
  Dim arrKeys, sEnum, sKeyPath
  If hDefKey = HKEY_LOCAL_MACHINE Then
    If sSubKeyName = "" Then
      sKeyPath = "HKEY_LOCAL_MACHINE\"
    Else
      sKeyPath = "HKEY_LOCAL_MACHINE\"&sSubKeyName&"\"
    End If
  ElseIf hDefKey = HKEY_USERS Then
    If sSubKeyName = "" Then
      sKeyPath = "HKEY_USERS\"
    Else
      sKeyPath = "HKEY_USERS\"&sSubKeyName&"\"
    End If
  Else
    If sSubKeyName = "" Then
      sKeyPath = hDefKey&"\"
    Else
      sKeyPath = hDefKey&"\"&sSubKeyName&"\"
    End If
  End If

  ' WScript.Echo sKeyPath
  On Error Resume Next
  objReg.EnumKey hDefKey, sSubKeyName, arrKeys
  If Err.Number <> 0 Then
    On Error Goto 0
    WScript.Echo "Error: "&sSubKeyName
    WScript.Echo Err.Description
    Exit Sub
  End If
  On Error Goto 0
  If Not IsNull(arrKeys) Then
    For Each sEnum In arrKeys
      If Len(sKeyPath&sEnum) > maxLen Then
        maxLen = Len(sKeyPath&sEnum)
        maxLine = sKeyPath&sEnum
      End If
      If Len(sEnum) = 0 Then
      ElseIf Len(sKeyPath&sEnum) > 8192 Then
        WScript.Echo "Over8k:"&vbTab&sKeyPath&sEnum
      ElseIf sSubKeyName = "" Then
        Call Find8kKey(hDefKey, sEnum)
      Else
        Call Find8kKey(hDefKey, sSubKeyName&"\"&sEnum)
      End If
    Next
  End If
End Sub

スクリプトをダブルクリックしても実行できますが、何度もダイアログが出るかもしれないので。

C:\>cscript find8kreg.vbs

別のコンピューターにイメージを展開しようとすると、Windows 7 または Windows サーバー 2008 R2 イメージの展開プロセスを停止します。