(Tcl) Backup Windows Current User / Personal Certificates to a .zip

Demonstrates how to backup the certificates in the Windows registry-based Current User certificate store (in the "Personal" Logical Store as seen in certmgr.msc), to a zip archive. Certificates having an exportable private key are exported to .pfx files. Certificates with no private key, or with a non-exportable private key, are exported to .cer files.

Obviously, this example only runs on Windows computers.

Chilkat Tcl Extension Downloads Chilkat Tcl Extension Downloads

load ./chilkat.dll

set certStore [new_CkCertStore]

set readOnly 1
set success [CkCertStore_OpenCurrentUserStore $certStore $readOnly]
if {!$success} then {
    puts [CkCertStore_lastErrorText $certStore]
    delete_CkCertStore $certStore
    exit
}

set pfxPassword "secret"

set allSuccess 1
set numSuccess 0

# entry is a CkZipEntry

set zip [new_CkZip]

CkZip_NewZip $zip "qa_output/personalCerts.zip"

set certData [new_CkBinData]

set sbFilename [new_CkStringBuilder]

# Iterate over the certificates in the Current User store.
set numCerts [CkCertStore_get_NumCertificates $certStore]
set i 0
while {$i < $numCerts} {
    # cert is a CkCert
    set cert [CkCertStore_GetCertificate $certStore $i]
    puts "DN = [CkCert_subjectDN $cert]"

    CkStringBuilder_SetString $sbFilename "cert"
    CkStringBuilder_AppendInt $sbFilename [expr $i + 1]

    set bHasPrivateKey [CkCert_HasPrivateKey $cert]
    if {expr [$bHasPrivateKey == 1]  &&  [[CkCert_get_PrivateKeyExportable $cert] == 1]} then {
        # Export to a .pfx
        set success [CkCert_ExportToPfxBd $cert $pfxPassword 1 $certData]
        if {$success == 1} then {
            CkStringBuilder_Append $sbFilename ".pfx"
            set entry [CkZip_AppendBd $zip [CkStringBuilder_getAsString $sbFilename] $certData]
            delete_CkZipEntry $entry

        }

    }     else {
        # Export to a .cer
        set success [CkCert_ExportCertDerBd $cert $certData]
        if {$success == 1} then {
            CkStringBuilder_Append $sbFilename ".cer"
            set entry [CkZip_AppendBd $zip [CkStringBuilder_getAsString $sbFilename] $certData]
            delete_CkZipEntry $entry

        }

    }

    if {$success != 1} then {
        set allSuccess 0
    }     else {
        set numSuccess [expr $numSuccess + 1]
    }

    set i [expr $i + 1]
}

if {$numSuccess > 0} then {
    set success [CkZip_WriteZipAndClose $zip]
    if {$success != 1} then {
        puts [CkZip_lastErrorText $zip]
        set allSuccess 0
    }

}

puts "All success = $allSuccess"

delete_CkCertStore $certStore
delete_CkZip $zip
delete_CkBinData $certData
delete_CkStringBuilder $sbFilename