'******************************************************************************************** ' AssocPrivKey.vbs attempts to associate a public/private key pair in ' a CryptoAPI key container with an existing certificate in the Current User MY store. ' ' Usage: assocprivkey.vbs ' where Certname is a substring of the certificate Subject field ' ' If a unique certificate matching Certname is found, and the certificate does ' NOT already have an associated private key, and the specified private key ' container exists, an attempt is made to set the certificates PrivateKey ' property to the PrivateKey instantiated from the keycontainer. ' If the keycontainer has both Exchange and Signature keys, they ' are both checked and a successful association exits the program. ' ' If the key container's public key (or keys if there are two), does not ' match the public key of the certificate, the association fails. ' If more than one certificate matches the certname substring, no ' association is attempted. ' ' See "CAPICOM Certificate.PrivateKey ' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/seccrypto/security/certificate_privatekey.asp ' Requires the CAPICOM 2 redistributable, and capicom.dll to be registered: ' ' JavaScience Consulting 03/18/2006 ' http://www.jensign.com '*********************************************************************************************** Option Explicit ' ---------- CAPICOM constants ---------------------------------------- Const CAPICOM_MEMORY_STORE = 0 Const CAPICOM_LOCAL_MACHINE_STORE = 1 Const CAPICOM_CURRENT_USER_STORE = 2 Const CAPICOM_CERTIFICATE_FIND_SUBJECT_NAME = 1 Const CAPICOM_STORE_OPEN_READ_ONLY = 0 Const CAPICOM_STORE_OPEN_READ_WRITE = 1 Dim KeySpecStrings(2) KeySpecStrings(0) = "Unknown" KeySpecStrings(1) = "Exchange" KeySpecStrings(2) = "Signature" Dim ProviderTypes(24) ProviderTypes(0) = "Unknown" ProviderTypes(1) = "PROV_RSA_FULL" ProviderTypes(2) = "PROV_RSA_SIG" ProviderTypes(3) = "PROV_DSS" ProviderTypes(4) = "PROV_FORTEZZA" ProviderTypes(5) = "PROV_MS_EXCHANGE" ProviderTypes(6) = "PROV_SSL" ProviderTypes(7) = "PROV_STT_MER" ProviderTypes(8) = "PROV_STT_ACQ" ProviderTypes(9) = "PROV_STT_BRND" ProviderTypes(10) = "PROV_STT_ROOT" ProviderTypes(11) = "PROV_STT_ISS" ProviderTypes(12) = "PROV_RSA_SCHANNEL" ProviderTypes(13) = "PROV_DSS_DH" ProviderTypes(14) = "PROV_EC_ECDSA_SIG" ProviderTypes(15) = "PROV_EC_ECNRA_SIG" ProviderTypes(16) = "PROV_EC_ECDSA_FULL" ProviderTypes(17) = "PROV_EC_ECNRA_FULL" ProviderTypes(18) = "PROV_DH_SCHANNEL" ProviderTypes(20) = "PROV_SPYRUS_LYNKS" ProviderTypes(21) = "PROV_RNG" ProviderTypes(22) = "PROV_INTEL_SEC" ProviderTypes(23) = "PROV_REPLACE_OWF" ProviderTypes(24) = "PROV_RSA_AES" Dim privatekey, keycontainer, keyspecindex Dim args, Store, Certificates, oCert, certname Set args = WScript.Arguments If args.Count<2 Then WScript.Echo "Usage: AssocPrivkey " WScript.Quit End If certname = args(0) keycontainer = args(1) '------------ Get The Certificate ---------------------------------------- Set Store = CreateObject("CAPICOM.Store") Store.Open CAPICOM_CURRENT_USER_STORE, "MY" ,CAPICOM_STORE_OPEN_READ_WRITE 'Open store Set Certificates = Store.Certificates.Find(CAPICOM_CERTIFICATE_FIND_SUBJECT_NAME, certname, 0) If Certificates.Count = 0 Then WScript.Echo "No certificates had SubjectName with substring matching """ & certname & """" WScript.Quit (1) End If If Certificates.Count > 1 Then WScript.Echo "More than one cert has SubjectName with substring matching """ & certname & """" WScript.Quit (1) End If Set oCert = Certificates(1) oCert.Display WScript.Echo "Found a certificate with SubjectName substring '" & certname & "'" & VbCrLf Set Certificates = Nothing Set Store = Nothing If oCert.hasPrivateKey() Then WScript.Echo "Certificate already has an associated private key" WScript.Quit(0) Else WScript.Echo "Certificate does NOT have an associated private key" End If ' ------- We now have a target certificate with no matching private key container associated with it --------- WScript.Echo VbCrLf & "Trying to open private key container '" & keycontainer & "'" & VbCrLf Set privatekey = CreateObject("CAPICOM.PrivateKey") privatekey.Open keycontainer If NOT privatekey.IsAccessible Then WScript.Echo "Private key in container '" & keycontainer & "' is not accessible or doesn't exist" WScript.Quit(1) End If If (Instr(1, privatekey.ProviderName , "Microsoft", 1) <> 1) Then WScript.Echo "This is not a Microsoft provider." WScript.Quit(1) End If WScript.Echo "Found private key container '" & keycontainer & "'" WScript.Echo "Provider Name: " & privatekey.ProviderName WScript.Echo "Provider Type: " & ProviderTypes(privatekey.ProviderType) WScript.Echo "Unique Container Name: " & vbCrLf & " " & privatekey.UniqueContainerName '---------- Check for existence of Signature and Exchange keypairs in this container ---- FOR keyspecindex = 1 to 2 WScript.Echo VbCrLf & "Checking for " & KeySpecStrings(keyspecindex) & " key ..." On Error Resume Next privatekey.Open keycontainer, , , keyspecindex,,True If Err.Number <> 0 Then WScript.Echo " Couldn't open key " & KeySpecStrings(keyspecindex) WScript.Echo " Error: " & Hex(Err.Number) & " " & Err.Description Else WScript.Echo " Keyspec: " & VbTab & KeySpecStrings(privatekey.keyspec) WScript.Echo " Accessible: " & VbTab & privatekey.IsAccessible WScript.Echo " Protected: " & VbTab & privatekey.IsProtected WScript.Echo " Exportable: " & VbTab & privatekey.IsExportable oCert.PrivateKey = privatekey If Err.Number <> 0 Then WScript.Echo "Couldn't Associate private key with certificate:" WScript.Echo "Error: " & Hex(Err.Number) & " " & Err.Description Else WScript.Echo "Successfully associated " & KeySpecStrings(privatekey.keyspec) & " private key with certificate" On Error Goto 0 Exit For ' we're done. End If On Error Goto 0 End If On Error Goto 0 Next ' ---------------------------- End Script -------------------------------------