Find Certificates that can be used for Signing

Download Chilkat Crypt ActiveX

This Visual Basic example program shows how to iterate over the certificates on a computer to find those that can be used for signing.

Private Sub Command1_Click()

    ' What certificates exist on my computer, and which
    ' ones can I use for creating digital signatures?
    
    Dim ccs As New ChilkatCreateCS
    
    Dim crypt As New ChilkatCrypt2
    
    unlocked = crypt.UnlockComponent("anything begins 30-day trial")
    If unlocked = 0 Then
        MsgBox "Encryption component is not unlocked!"
        Exit Sub
    End If
    
    ' Use the Microsoft Enhanced Cryptographic Service Provider
    ' Add a reference to ChilkatUtil for the ChilkatCSP object
    Dim csp As New ChilkatCSP
    csp.SetProviderMicrosoftEnhanced
    crypt.SetCSP csp
    
    ' -------------------------------------------------------
    ' First check the current-user certificate store.
    ' -------------------------------------------------------
    Dim certStore As ChilkatCertStore
    Set certStore = ccs.OpenCurrentUserStore()
    
    Text1.Text = "Current User Certificate Store -------------"
    Text1.Text = Text1.Text & vbCrLf & "-"
    
    Dim cert As ChilkatCert
    Dim signature As String
    
    For i = 0 To certStore.NumCertificates - 1
        Set cert = certStore.GetCertificate(i)
        
        ' Display the certificate we are testing..
        Text1.Text = Text1.Text & vbCrLf & cert.SubjectDN
        
        ' Set the certificate to be used for signing, and our output string encoding.
        crypt.SetSigningCert cert
        crypt.EncodingMode = "base64"
        
        ' Try signing....
        signature = crypt.SignStringENC("This is a test")
        If Len(signature) = 0 Then
            ' Failed to create signature
            Text1.Text = Text1.Text & vbCrLf & "FAILED"
            If cert.HasPrivateKey() = 0 Then
                Text1.Text = Text1.Text & vbCrLf & "NO PRIVATE KEY"
            End If
            Text1.Text = Text1.Text & vbCrLf & crypt.LastErrorText
        Else
            Text1.Text = Text1.Text & vbCrLf & "SUCCESS!"
            Text1.Text = Text1.Text & vbCrLf & crypt.LastErrorText
        End If
        
        Text1.Text = Text1.Text & vbCrLf & "----------------" & vbCrLf
        Text1.Refresh
    Next
    
    
    ' -------------------------------------------------------
    ' Now check the local machine certificate store.
    ' -------------------------------------------------------
    Set certStore = ccs.OpenLocalSystemStore()
    
    Text1.Text = Text1.Text & vbCrLf & "---------------------------------------------"
    Text1.Text = Text1.Text & vbCrLf & "Local Machine Certificate Store -------------"
    Text1.Text = Text1.Text & vbCrLf & "---------------------------------------------"
    Text1.Text = Text1.Text & vbCrLf & "-"
    
    For i = 0 To certStore.NumCertificates - 1
        Set cert = certStore.GetCertificate(i)
        
        ' Display the certificate we are testing..
        Text1.Text = Text1.Text & vbCrLf & cert.SubjectDN
        
        ' Set the certificate to be used for signing, and our output string encoding.
        crypt.SetSigningCert cert
        crypt.EncodingMode = "base64"
        
        ' Try signing....
        signature = crypt.SignStringENC("This is a test")
        If Len(signature) = 0 Then
            ' Failed to create signature
            Text1.Text = Text1.Text & vbCrLf & "FAILED"
            If cert.HasPrivateKey() = 0 Then
                Text1.Text = Text1.Text & vbCrLf & "NO PRIVATE KEY"
            End If
            Text1.Text = Text1.Text & vbCrLf & crypt.LastErrorText
        Else
            Text1.Text = Text1.Text & vbCrLf & "SUCCESS!"
            Text1.Text = Text1.Text & vbCrLf & crypt.LastErrorText
        End If
        
        Text1.Text = Text1.Text & vbCrLf & "----------------" & vbCrLf
        Text1.Refresh
    Next
    
    
    ' -------------------------------------------------------
    ' Now check Outlook's certificate store.
    ' -------------------------------------------------------
    Set certStore = ccs.OpenOutlookStore()
    If certStore Is Nothing Then
        Exit Sub
    End If
    
    Text1.Text = Text1.Text & vbCrLf & "---------------------------------------------"
    Text1.Text = Text1.Text & vbCrLf & "Outlook Certificate Store -------------------"
    Text1.Text = Text1.Text & vbCrLf & "---------------------------------------------"
    Text1.Text = Text1.Text & vbCrLf & "-"
    
    For i = 0 To certStore.NumCertificates - 1
        Set cert = certStore.GetCertificate(i)
        
        ' Display the certificate we are testing..
        Text1.Text = Text1.Text & vbCrLf & cert.SubjectDN
        
        ' Set the certificate to be used for signing, and our output string encoding.
        crypt.SetSigningCert cert
        crypt.EncodingMode = "base64"
        
        ' Try signing....
        signature = crypt.SignStringENC("This is a test")
        If Len(signature) = 0 Then
            ' Failed to create signature
            Text1.Text = Text1.Text & vbCrLf & "FAILED"
            If cert.HasPrivateKey() = 0 Then
                Text1.Text = Text1.Text & vbCrLf & "NO PRIVATE KEY"
            End If
            Text1.Text = Text1.Text & vbCrLf & crypt.LastErrorText
        Else
            Text1.Text = Text1.Text & vbCrLf & "SUCCESS!"
            Text1.Text = Text1.Text & vbCrLf & crypt.LastErrorText
        End If
        
        Text1.Text = Text1.Text & vbCrLf & "----------------" & vbCrLf
        Text1.Refresh
    Next
    
    
End Sub