ListLargeRegistryValues.vbs

'ListLargeRegistryValues v1.0.1, March 2022.
'https://www.reddit.com/user/jcunews1
'https://pastebin.com/u/jcunews
'https://greasyfork.org/en/users/85671-jcunews
'
'This script will display top 50 registry values which use more than 2048 Bytes

sub processValues(rootKey, subkeyName)
  dim valNames, valTypes, i, sk, dt, ln, j
  if (rg.enumValues(rootKey, subkeyName, valNames, valTypes) = 0) and _
    (not isnull(valNames)) then
    for i = 0 to ubound(valNames)
      if not isnull(valNames(i)) then
        if subkeyName <> "" then
          sk = subkeyName & "\" & valNames(i)
        else
          sk = valNames(i)
        end if
        ln = -1
        'use less buggy RegRead first
        on error resume next
        dt = ws.regread(rootKeyNames(rootKey) & "\" & sk)
        if err.number = 0 then
          on error goto 0
          select case vartype(dt)
            case 3 ln = 4 'long
            case 8 ln = (len(dt) + 1) * 2 'string
            case else 'array
              if ubound(dt) >= 0 then
                if vartype(dt(0)) = 8 then 'string array
                  ln = 2
                  for j = 0 to ubound(dt)
                    ln = ln + ((len(dt(j)) + 1) * 2)
                  next
                else 'byte array
                  ln = ubound(dt) + 1
                end if
              end if
          end select
        else
          on error goto 0
        end if
        'use StdRegProv for value types unsupported by RegRead
        if ln < 0 then
          select case valTypes(i)
            case 3 'REG_BINARY
              if (rg.getBinaryValue(rootKey, subkeyName, valNames(i), _
                dt) = 0) and (not isnull(dt)) then ln = ubound(dt) + 1
            case 5 'REG_DWORD_BIG_ENDIAN
              if (rg.getDwordValue(rootKey, subkeyName, valNames(i), _
                dt) = 0) and (not isnull(dt)) then ln = 4
            case 11 'REG_QWORD
              if (rg.getQwordValue(rootKey, subkeyName, valNames(i), _
                dt) = 0) and (not isnull(dt)) then ln = 8
          end select
        end if
        if ln > 2048 then
          rs.addnew rf, array(ln, valNames(i), _
            rootKeyNames(rootKey) & "\" & sk)
          rs.update
        end if
      end if
    next
  end if
end sub

sub processSubkeys(rootKey, subkeyName)
  processValues rootKey, subkeyName
  dim keyNames, kn
  if (rg.enumKey(rootKey, subkeyName, keyNames) = 0) and _
    (not isnull(keyNames)) then
    for each kn in keyNames
      if subkeyName <> "" then kn = subkeyName & "\" & kn
      processSubkeys rootKey, kn
    next
  end if
end sub

set rs = createobject("adodb.recordset")
rs.fields.append "size", 6, 8
rs.fields.append "name", 202, 4500
rs.fields.append "path", 202, 4500
rs.open
rf = array("size", "name", "path")

HKEY_CLASSES_ROOT   = 2147483648
HKEY_CURRENT_USER   = 2147483649
HKEY_LOCAL_MACHINE  = 2147483650
HKEY_USERS          = 2147483651
HKEY_CURRENT_CONFIG = 2147483653
set rootKeyNames = createobject("scripting.dictionary")
rootKeyNames.add 2147483648, "HKEY_CLASSES_ROOT"
rootKeyNames.add 2147483649, "HKEY_CURRENT_USER"
rootKeyNames.add 2147483650, "HKEY_LOCAL_MACHINE"
rootKeyNames.add 2147483651, "HKEY_USERS"
rootKeyNames.add 2147483653, "HKEY_CURRENT_CONFIG"

'bug: StdRegProv accesses the registry using the system account.
'     so GetExpandedStringValue expands any environment variable from the
'     system profile.
'note: GetExpandedStringValue works the same as GetStringValue.
'note: RegRead throws an exception for unsupported value types.
'undocumented: all StdRegProv Enum/Get methods return null for empty values.

set rg = getobject("winmgmts:stdregprov")
set ws = createobject("wscript.shell")
on error resume next
wscript.stdout.write "This script will display top 50 registry values " & _
  "which use more than 2048 Bytes." & vbcrlf & "Retriving registry values... "
if err.number <> 0 then
  on error goto 0
  ws.run "cscript.exe //nologo """ & wscript.scriptfullname & """", _
    1, true
  wscript.quit
end if
on error goto 0
processSubkeys HKEY_CURRENT_USER, ""
processSubkeys HKEY_LOCAL_MACHINE, ""
wscript.stdout.writeline rs.recordcount & " usable values retrieved." & vbcrlf
rs.sort = "size desc"
if rs.recordcount > 0 then
  rs.movefirst
  c = 0
  s = ""
  do until rs.eof or (c >= 50)
    s = s & rs.fields("path") & vbcrlf & "  " & _
      rs.fields("name") & " = " & rs.fields("size") & " Bytes" & vbcrlf
    wscript.stdout.write s
    c = c + 1
    rs.movenext
  loop
  wscript.stdout.write "Press ENTER to exit; or enter 'save' then press " & _
    "ENTER, to save list into" & vbcrlf & _
    "'Large Registry Values.txt' file on the Desktop... "
  if ucase(trim(wscript.stdin.readline)) = "SAVE" then
    set f = createobject("scripting.filesystemobject").createtextfile( _
      ws.environment("process")("userprofile") & _
      "\desktop\Large Registry Values.txt", true)
    f.write s
  end if
else
  wscript.stdout.write "Press ENTER to exit..."
  wscript.stdin.readline
end if