'枚举注册表项及值
Const HKEY_LOCAL_MACHINE = &H80000002
Dim regWMI, FSO, Text
Set FSO = CreateObject("Scripting.FileSystemObject")
Set regWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") 
Dim regRoot, regPath, regStr
regRoot = HKEY_LOCAL_MACHINE
regPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
FSO.OpenTextFile("RegList.txt", 2, True).Write "HomePath:HKEY_LOCAL_MACHINE" & regPath & vbCrLf & vbcrlf & "RegList:" & vbCrLf
Set Text = FSO.OpenTextFile("RegList.txt", 8, True)
GetValues regPath
GetKeys regPath
Set FSO = Nothing
Set regWMI = Nothing
CreateObject("Wscript.Shell").run "cmd /cRegList.txt", True, False

Function GetKeys(Path)
  'Text.WriteLine path & vbCrLf
  Dim arrRegKeys, regKey
  regWMI.Enumkey regRoot, path, arrRegKeys
  For Each regKey In arrRegKeys
    On Error Resume Next
    newpath = path & "\" & regKey
    GetValues newpath
    GetKeys newpath
  Next
End Function

Function GetValues(path)
  Dim regValue, arrRegNames, arrValueTypes, arrRegValues, Multi, regValueType
  regWMI.EnumValues regRoot, path, arrRegNames, arrValueTypes
  For i = 0 To UBound(arrRegNames)
    If Len(arrRegNames(i)) > 0 Then
      Multi = vbNullString
      Select Case arrValueTypes(i)
        Case 1 
          regWMI.GetStringValue regRoot, path, arrRegNames(i), regValue
          regValueType = "REG_SZ"
        Case 2 
          regWMI.GetExpandedStringValue regRoot, path, arrRegNames(i), regValue
          regValueType = "REG_EXPAND_SZ"
        Case 3 
          regWMI.GetBinaryValue regRoot, path, arrRegNames(i), regValue
          regValueType = "REG_BINARY"
        Case 4 
          regWMI.GetDwordValue regRoot, path, arrRegNames(i), regValue
          regValueType = "REG_DWORD"
        Case 7 
          regWMI.GetMultiValue regRoot, path, arrRegNames(i), arrRegValues
          regValueType = "REG_MULTI_SZ"
          Multi = "yes"
      End Select
      If Multi = "yes" Then 
        For Each str In arrRegValues 
          regValue = regValue & str & vbTab
        Next
      End If
      newpath = Replace(path, regPath, "")
      If Left(newpath, 1) = "\" Then newpath = Mid(newpath,2,Len(newpath))
      Text.WriteLine newpath & arrRegNames(i) & vbTab & regValueType & vbTab & regValue
    End If 
  Next
End Function
复制代码