Source code for listcert.vbs

' List all certificates

' Version 0.10 ALFA

' Known issue:

'     Not enough storage available for large amounts of data

'     => display result immediately instead of appending to a string

' Written by Rob van der Woude

' http://www.robvanderwoude.com

Option Explicit

Const CAPICOM_MEMORY_STORE                =   0

Const CAPICOM_LOCAL_MACHINE_STORE         =   1

Const CAPICOM_CURRENT_USER_STORE          =   2

Const CAPICOM_ACTIVE_DIRECTORY_USER_STORE =   3

Const CAPICOM_SMART_CARD_USER_STORE       =   4

Const CAPICOM_MY_STORE                    = "My"

Const CAPICOM_CA_STORE                    = "CA"

Const CAPICOM_ROOT_STORE                  = "Root"

Const CAPICOM_STORE_OPEN_READ_ONLY        =   0

Const CAPICOM_STORE_OPEN_READ_WRITE       =   1

Const CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED  =   2

Const CAPICOM_STORE_OPEN_EXISTING_ONLY    = 128

Const CAPICOM_STORE_OPEN_INCLUDE_ARCHIVED = 256

WScript.Echo "Personal Certificates : " & ListCerts( CAPICOM_CURRENT_USER_STORE, CAPICOM_MY_STORE )

WScript.Echo "CA Certificates       : " & ListCerts( CAPICOM_LOCAL_MACHINE_STORE, CAPICOM_CA_STORE )

WScript.Echo "Root Certificates     : " & ListCerts( CAPICOM_LOCAL_MACHINE_STORE, CAPICOM_ROOT_STORE )

Function ListCerts( myStoreLocation, myStoreName )

	Dim colCerts, objCert, objStore, strReturn

	strReturn = ""

	Set objStore = CreateObject( "CAPICOM.Store.2" )

	objStore.Open myStoreLocation, myStoreName, CAPICOM_STORE_OPEN_READ_ONLY Or CAPICOM_STORE_OPEN_EXISTING_ONLY

	Set colCerts = objStore.Certificates

	strReturn = colCerts.Count & vbCrLf & vbCrLf

	If colCerts.Count > 0 Then

		For Each objCert In colCerts

			strReturn = strReturn & "Issued By     : " & objCert.IssuerName    & vbCrLf

			strReturn = strReturn & "Subject Name  : " & objCert.SubjectName   & vbCrLf

			strReturn = strReturn & "Version       : " & objCert.Version       & vbCrLf

			strReturn = strReturn & "Is Valid      : " & objCert.IsValid       & vbCrLf

			strReturn = strReturn & "Valid From    : " & objCert.ValidFromDate & vbCrLf

			strReturn = strReturn & "Valid Until   : " & objCert.ValidToDate   & vbCrLf

			strReturn = strReturn & "Serial Number : " & objCert.SerialNumber  & vbCrLf

			strReturn = strReturn & "Thumbprint    : " & objCert.Thumbprint    & vbCrLf & vbCrLf

		Next

	End If

	Set colCerts = Nothing

	Set objStore = Nothing

	ListCerts = strReturn

End Function