'******************************************************************************\
' FriendlyName.vbs displays all certificates in a specified CurrentUserStore
' Determines if extended property "CAPICOM_PROPID_FRIENDLY_NAME" is defined,
' and optionally allows user to add/change the selected certificate "Friendly Name".
'
' On Win2000+, the defined store "names" for location "CurrentUserStore" are listed
' in the win32 registry as subkeys under:
'  HKEY_CURRENT_USER\Software\Microsoft\SystemCertificates
'
' Requires the CAPICOM 2 :
'  http://www.microsoft.com/downloads/release.asp?ReleaseID=37986
'
'                                                   M. Gallant  05/07/2002
' ******************************************************************************/

Option Explicit

Dim Store, Certificate
Dim storename, Message, Title, infotxt, friendlynamein
Dim ExtProp, ExtendedProps, FriendlyProp, newfriendlyname, friendlyInfo, result

'-- Some typical cert store names in CurrentUserStore location ----
 Const mystore = "MY"
 Const friends = "AddressBook"
 Const trustroot = "ROOT"
 Const request = "REQUEST"
 Const castore = "CA"
 Const mitch = "mitch"
 Const CAPICOM_PROPID_FRIENDLY_NAME = 11
 Const CAPICOM_ENCODE_ANY = -1
 Const CAPICOM_ENCODE_BASE64 = 0 
 Const CAPICOM_ENCODE_BINARY = 1
 Const CAPICOM_STORE_OPEN_READ_WRITE = 1
 Const CAPICOM_CURRENT_USER_STORE = 2
'--------------------------------------------------------

Message = "Enter a certificate store name:"           
Title = "FriendlyName - by M. Gallant"

'--- Prompt to get certificate store name ---
storename = InputBox(Message, Title, mystore, 300, 300)

' Evaluate the user input.
If storename = "" Then    ' Canceled by the user so quit
    WScript.Quit
End If


infotxt = "-- Certificates in " & storename & " store: -----" & vbCrLf & vbCrLf

Set Store = CreateObject("CAPICOM.Store")
Store.Open CAPICOM_CURRENT_USER_STORE, _
  storename ,CAPICOM_STORE_OPEN_READ_WRITE   'open currentuser location for read/write

For Each Certificate In Store.Certificates
 Certificate.Display

 friendlyInfo = "Current selected certificate:" & vbCrLf & _
	Certificate.SubjectName & vbCrLf & vbCrLf & _
	"No Friendly Name defined." & vbCrLf & "Do you wish to add a Friendly Name now?" & vbCrLf
 friendlynamein = "newfriendlyname"

 For Each ExtProp In Certificate.ExtendedProperties  'enumate properties and check for Friendly
  If ExtProp.PropID = CAPICOM_PROPID_FRIENDLY_NAME  Then
	friendlyInfo = "Current selected certificate:" & vbCrLf & _
	Certificate.SubjectName & vbCrLf & vbCrLf & _
	"Do you wish to change the Friendly Name now? " & vbCrLf & _	
	 "Current friendly name: " & ExtProp.Value(CAPICOM_ENCODE_BINARY)
  friendlynamein = ExtProp.Value(CAPICOM_ENCODE_BINARY)
  End If
 Next

  result =  MsgBox (friendlyInfo & vbCrLf ,vbYesNo+vbExclamation, _
		"Certificate ""Friendly Name"" Change")
    If result = vbYES Then
	Set ExtendedProps = Certificate.ExtendedProperties
	newfriendlyname = InputBox("Enter new cert Friendly Name", _
	 "Certificate Friendly Name", friendlynamein, 450, 450)

	If NOT (newfriendlyname = "") Then    ' Canceled by the user so quit
	Set FriendlyProp = CreateObject("CAPICOM.ExtendedProperty")
	FriendlyProp.PropID = CAPICOM_PROPID_FRIENDLY_NAME
	FriendlyProp.Value(CAPICOM_ENCODE_BINARY) = newfriendlyname + Chr(0)
	On Error Resume Next
	 ExtendedProps.Add FriendlyProp
	  If Err <> 0 Then
	   WScript.Echo err.number & "  " & err.description
	   Err.Clear
	  End If
	On Error GoTo 0
	End If

    End If
Next

Set Store = Nothing
'------  End CertLister script -------------------------