'******************************************************************************
' PVKCertsWMI.vbs lists all certificates in an array of certificate stores
' that contain a private key. Lists the key container names and key spec
' For Current User Store, finds ALL key containers, and displays key containers
' that don't have an associated certificate.
'
' Certificate stores specified either with:
'	- fixed initialized Storenames() array
'	- enumerated store names via WMI (Win2000/XP) and registry subkeys:
'		<regtree>\Software\Microsoft\SystemCertificates
'
' Requires the CAPICOM 2 redistributable, and capicom.dll to be registered:
'  The release is available for download at:
'  http://www.microsoft.com/downloads/details.aspx?FamilyID=860ee43a-a843-462f-abb5-ff88ea5896f6&DisplayLang=en
'  http://msdn.microsoft.com/library/default.asp?url=/library/en-us/security/security/capicom_reference.asp
' Requires WMI (included with Win2000/XP; optional install for Win9x/NT
'	
'                                                   M. Gallant  07/08/2002
' ******************************************************************************

Option Explicit
Const Title = "PVKCertsWMI"
Const CAPICOM_CERT_INFO_SUBJECT_SIMPLE_NAME       = 0
Const CAPICOM_MEMORY_STORE                        = 0
Const CAPICOM_LOCAL_MACHINE_STORE                 = 1
Const CAPICOM_CURRENT_USER_STORE                  = 2
Const CAPICOM_STORE_OPEN_READ_ONLY                = 0
Const CAPICOM_STORE_OPEN_EXISTING_ONLY            = 128
Const HKEY_LOCAL_MACHINE                          = &H80000002
Const HKEY_CURRENT_USER                           = &H80000001 
Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
Const MS_ENHANCED_PROV = "Microsoft Enhanced Cryptographic Provider v1.0"
Const MS_STRONG_PROV = "Microsoft Strong Cryptographic Provider"

Dim KeySpecStrings
KeySpecStrings = Array("Unknown", "Exchange", "Signature")

Dim WshShell, dict_containers
Dim Store, Certificate
Dim wmistores   : wmistores = True
Dim storetype   : storetype = CAPICOM_CURRENT_USER_STORE
Dim regtree
Dim i, arg1
Dim Storenames


If (NOT InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
    MsgBox Title & " requires cscript.exe to run. ", vbInformation, Title
    WScript.Quit            ' Terminate script.
End If

If WScript.Arguments.Count = 1 Then
 arg1 = LCase(WScript.Arguments(0))
 If arg1 = "c" OR arg1 = "cu" Then
	storetype = CAPICOM_CURRENT_USER_STORE
 ElseIf arg1 = "l" OR arg1 = "lm" Then
	storetype = CAPICOM_LOCAL_MACHINE_STORE
 ElseIf arg1 = "u" OR arg1 = "?" Then
	usage
 End If
End If

 If storetype = CAPICOM_CURRENT_USER_STORE Then
	regtree = HKEY_CURRENT_USER
  ElseIf storetype = CAPICOM_LOCAL_MACHINE_STORE Then
	regtree = HKEY_LOCAL_MACHINE
 End If


'Check if launched with Cscript host; if not, relaunch
If (NOT InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
    Set WshShell = WScript.CreateObject("WScript.Shell")
    WshShell.Run "CScript.exe " & """" & WScript.ScriptFullName & """"
    WScript.Quit            ' Terminate script.
End If


If NOT wmistores Then
  Storenames = Array("MY", "AddressBook", "mitch", "Request", "root", "register", "CA", "junk")
 Else     'get array of storenames from registry via WMI
  If NOT GetWMIStoreNames(regtree, Storenames) Then
	WScript.Echo "Could not get Certificate store names with WMI"
	WScript.Quit
  End If
End If



'-- Get list of all key containers (some may not have associated keys ---
If storetype = CAPICOM_CURRENT_USER_STORE Then
  Set dict_containers = GetAllContainers()
End If
'-------------------------------------------------


WScript.Echo "--- The following certificates have an associated private key: ---" & vbCrLf
For i = 0 To Ubound(Storenames)
 Set Store = CreateObject("CAPICOM.Store")
 On Error Resume Next
 Store.Open storetype, Storenames(i), CAPICOM_STORE_OPEN_EXISTING_ONLY
 If Err <> 0 Then
  WScript.Echo "Store: " & Storenames(i) & " not found"
    Else
  WScript.Echo "Store: " & Storenames(i) & " (" & Store.Certificates.Count & " certs)"
  For Each Certificate In Store.Certificates
    If Certificate.HasPrivateKey Then
     WScript.Echo "  CN=" & Certificate.getInfo(CAPICOM_CERT_INFO_SUBJECT_SIMPLE_NAME)  & vbCrLf & _
	"  Container name:   " & Certificate.PrivateKey.ContainerName & vbCrLf & _
	"  Provider:         " & Certificate.PrivateKey.ProviderName & vbCrLf & _
	"  PublicKey length: " & CStr(Certificate.PublicKey.Length) & " bits" & vbCrLf & _
	"  Key spec:         " & KeySpecStrings(Certificate.PrivateKey.KeySpec) & vbCrLf
      If dict_containers.Exists(Certificate.PrivateKey.ContainerName) Then
	 dict_containers.Remove(Certificate.PrivateKey.ContainerName)
      End If
    End If
  Next
 End If
 On Error GoTo 0
 Set Store = Nothing
Next

If storetype = CAPICOM_CURRENT_USER_STORE Then
 WScript.Echo vbCrLf & "--- The following " & dict_containers.Count & _
	" key containers have no associated Certificates: ---"
  For i=0 To dict_containers.Count-1
   WScript.Echo dict_containers.Keys()(i)
  Next
End If

WScript.StdIn.ReadLine   'if launched by wscript or double-clicking, allow view of window


'******************************************************************************
' Function  : GetAllContainers
''
' Return    : Dictionary containing all key containers.
'******************************************************************************
Function GetAllContainers
 Dim objXen, container, dict_containers, i
  Set objXen = CreateObject("CEnroll.CEnroll.1")
  objXen.ProviderName = MS_DEF_PROV
  Set dict_containers = CreateObject("Scripting.Dictionary")
  i = 0
    On Error Resume Next
    Do
        container = objXen.enumContainers(i)
	 If Err <> 0 Then  'enumeration ends with error 
            Exit Do
         End If
	dict_containers.add container, ""
        'WScript.Echo i & " " & container
        i = i + 1
    Loop
  On Error GoTo 0
  
 Set GetAllContainers = dict_containers
 'WScript.Echo "Size of Dictionary: " & dict_containers.Count
End Function


'******************************************************************************
' Function  : GetWMIStoreNames
'
' Parameter : Storenames    - array to return enumerated storenames.
' Parameter : Storelocation - HKEY_LOCAL_MACHINE  or HKEY_CURRENT_USER
'
' Return    : True if successful registry enumeration, else False.
'******************************************************************************
Function GetWMIStoreNames(Storelocation, Storenames)   'Get storenames via WMI & registry
 Dim lRC
 Dim sPath
 Dim sKeys()
 Dim objRegistry
 GetWMIStoreNames = False

On Error Resume Next
Set objRegistry = getObject("winmgmts:root\default:StdRegProv")
If Err <> 0 Then
 WScript.Echo "*** Failed to get Registry object via WMI ***" & vbCrLF & _
 "*** WMI requires Win2000/XP or a separate install for Win9x/NT ***"
 return
End If
sPath = "Software\Microsoft\SystemCertificates"
lRC = objRegistry.EnumKey(Storelocation, sPath, sKeys)
 If (lRC = 0) And (Err.Number = 0) Then
    ' WScript.Echo "Got subkey list with " & UBound(sKeys) & " subkeys"
    Storenames = sKeys
    GetWMIStoreNames = True
 Else
    GetWMIStoreNames = False
 End If
Set objRegistry = Nothing
On Error goto 0
End Function
'------  End PVKCertsWMI script -------------------------
Sub Usage
  MsgBox "Usage: PVKCertsWMI.vbs  [u | ? | C | CU | L | LM] ", _
	vbInformation, Title
  WScript.Quit(1)
End Sub