Active Directory ストアを開いて証明書を取得する

[CAPICOM は、次のオペレーティング システムで使用できる 32 ビットのみのコンポーネントです: Windows Server 2008、Windows Vista、および Windows XP。 代わりに、.NET Frameworkを使用してセキュリティ機能を実装します。 詳細については、「 CAPICOM を使用する代替手段」を参照してください。

証明書 は、ドメインのユーザーの証明書が格納されている Active Directory ストアから取得できます。 Active Directory ストアは読み取り専用モードでのみ開くことができます。また、アプリケーションは CAPICOM を使用して Active Directory ストアに証明書を追加したり、Active Directory ストアから証明書を削除したりすることはできません。

CAPICOM エラーでは、 Err.Number の負の 10 進値が返されます。 詳細については、「 CAPICOM_ERROR_CODE」を参照してください。 Err.Number の正の 10 進値については、「Winerror.h」を参照してください。

次の例は、Active Directory ストアを開き、そのストアから証明書を取得する方法を示しています。

Sub OpenADStore()
        On Error GoTo ErrorHandler
        Dim mystore As Store
        Set mystore = New Store
        
        ' Put a string that represents the name of a certificate 
        ' subject in SubjectNameCn. In the following example, 
        ' the * wildcard character is used in the string so that
        ' the Active Directory store will be searched for all 
        ' certificates with a subject name beginning with 'S.'
       
        Dim SubjectNameCn As String
        ' The following uses 'cn=' and the * wildcard character.
        ' Using this string, all certificates in the Active Directory
        ' store with a subject name beginning with an 'S' would
        ' be returned.

        SubjectNameCn = "CN=S*"
        
        ' Active Directory stores can only be opened with read-only
        ' access.
        
         mystore.Open CAPICOM_ACTIVE_DIRECTORY_USER_STORE, _
              SubjectNameCn, CAPICOM_STORE_OPEN_READ_ONLY
        
        If mystore.Certificates.Count < 1 Then
               MsgBox "A certificate for " & SubjectNameCn & _
                      " was not found "
        Else
               MsgBox "The certificate has been retrieved."
        End If
        
        Set mystore = Nothing
        Exit Sub

ErrorHandler:
         
         If Err.Number > 0 Then
               MsgBox "Visual Basic error found:" & Err.Description
         Else
               MsgBox "CAPICOM error found : " & Err.Number
         End If
End Sub