'******************************************************************************
' PVKCertsWMI.vbs lists all certificates in an array of certificate stores
' that contain a private key. Lists the key container names and key spec
' 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:
'  http://www.microsoft.com/downloads/release.asp?ReleaseID=37986   (beta release)
'  http://msdn.microsoft.com/library/default.asp?url=/library/en-us/security/security/capicom_start_page.asp
' Requires WMI (included with Win2000/XP; optional install for Win9x/NT
'	
'                                                   M. Gallant  05/27/2002
' ******************************************************************************

Option Explicit
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 

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

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

'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

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
    End If
  Next
 End If
 On Error GoTo 0
 
 Set Store = Nothing
Next

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


'******************************************************************************
' 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 -------------------------