Wednesday, November 23, 2016

All Keys information

'''
''' No Warrenty Provided for this code. Use at your own risk.
'''

Const HKEY_CLASSES_ROOT   = &H80000000
Const HKEY_CURRENT_USER   = &H80000001
Const HKEY_LOCAL_MACHINE  = &H80000002
Const HKEY_USERS          = &H80000003
Const REG_SZ        = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY    = 3
Const REG_DWORD     = 4
Const REG_MULTI_SZ  = 7


'' Looking at the local machines registry
Set reg = GetObject("winmgmts://./root/default:StdRegProv")

 '' Check the current user hive for values
FindAndDeleteKey HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Connections"

'' get a list of user hives
  reg.EnumKey HKEY_USERS, "", subkeys
  If Not IsNull(subkeys) Then
    '' Iterate through each hive and call the sub to find and delete the values
    For Each sk In subkeys
        FindAndDeleteKey HKEY_USERS, sk & "\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Connections"
    Next
  End If


''' sub '''
''Find and display the value of the related keys.
Sub FindAndDeleteKey(root, key)
  reg.EnumValues root, key, names, types
  If Not IsNull(names) Then
    For Each name In names
        '' For each value in this key searh for the two valeus we are looking for.
      If (name = "DefaultConnectionSettings") Or (name = "SavedLegacySettings") Then
        Dim strValue
        reg.GetBinaryValue root, key, name, strValue
        PrintData key, name, regReadBinary(strValue)
        '''''''''
        '' We have all the data we need, we could put a delete command here
        '' to remove the entry if the user has the permissions to do this.
        '''''''''
      End If
    Next
  End If
End Sub

Sub PrintData(heading,body,data)
    wScript.Echo VbCrLf + "#################"
    wScript.Echo "###  Key  ###"   
    wScript.Echo heading
    wScript.Echo "### Value ###"
    wScript.Echo body
    wScript.Echo "### Data  ###"
    wScript.Echo data
    wScript.Echo "#################" + VbCrLf
End Sub

''Convert REG_BINARY to ASCII String.
Function regReadBinary(aBin)
      Dim aInt(), i, iBinSize, sString, iChar, sChar
      If Err.Number = 0 Then
             iBinSize = UBound(aBin)
             ReDim aInt(iBinSize)
             For i = LBound(aBin) To UBound(aBin)
                   aInt(i) = CInt(aBin(i))
                   If aInt(i) <> 0 Then
                         iChar = aInt(i)
                         sChar = Chr(iChar)
                         sString = sString&sChar
                   End If
             Next
             regReadBinary=sString
      End If
End Function

No comments:

Post a Comment