Option Explicit
Const AT_KEYEXCHANGE As Long = 1
Const PROV_GOST_2001_DH As Long = 75
Function GenerateSelfSignedCertRequest(ByVal sDN As String, ByVal sEKU As String) As String
    Dim oEnroll As XENROLLLib.CEnroll
    Set oEnroll = New XENROLLLib.CEnroll
    oEnroll.ProviderType = PROV_GOST_2001_DH
    oEnroll.ProviderName = "Crypto-Pro GOST R 34.10-2001 Cryptographic Service Provider"
    oEnroll.KeySpec = AT_KEYEXCHANGE
    GenerateSelfSignedCertRequest = oEnroll.createPKCS10(sDN, sEKU)
End Function

Private Sub cmdGenerate_Click()
    Dim strZapros As String, FN As String
    Dim strDN As String, intFH As Integer
    
    If Len(txtFIO.Text) < 10 Or Len(txtOrg.Text) < 4 Or Len(txtDolg.Text) < 4 Then
        'MsgBox "Не полностью заполнены поля с информацией об уполномоченном лице.", vbCritical, "Ошибка заполенния!"
        'Exit Sub
    End If
    If Len(txtCity.Text) < 4 Or Len(txtOblast.Text) < 8 Then
        'MsgBox "Не полностью указано местонахождение организации.", vbCritical, "Ошибка заполенния!"
        'Exit Sub
    End If
    
    strDN = "CN=" + txtFIO.Text + ", S=" + txtOblast.Text + " , L=" + txtCity.Text + ", O=" + txtOrg.Text + ", OU=" + txtDolg.Text + ",  C=RU"
    strZapros = GenerateSelfSignedCertRequest(strDN, "1.3.6.1.5.5.7.3.4, 1.3.6.1.5.5.7.3.2, 1.2.643.2.2.34.6")
    
    FN = "c:\Запрос " + txtFIO.Text + ".p10"
    intFH = FreeFile
    Open FN For Output As intFH
    Print #intFH, strZapros
    MsgBox strZapros
    Close intFH
    
End Sub

Option Explicit
Const AT_KEYEXCHANGE As Long = 1
Const PROV_GOST_2001_DH As Long = 75

Private Sub cmdUpdate_Click()
    'frmUpdateQuest.Visible = True
    'Unload frmMain
    UpdateCert
End Sub


Function ReverseDN(ByVal sDN As String)
    Dim dnArray As Variant, i As Long, rdn As String
    dnArray = Split(sDN, ",")
    ReverseDN = ""
    For i = UBound(dnArray) To LBound(dnArray) Step -1
        rdn = Trim(dnArray(i))
        If Len(rdn) > 0 Then
            If Len(ReverseDN) = 0 Then
                ReverseDN = rdn
            Else
                ReverseDN = ReverseDN & ", " & rdn
            End If
        End If
    Next
End Function

Function GenerateRenewalCertRequest(ByVal oSignerCertificate As CAPICOM.Certificate, ByVal sEKU As String) As String
    Dim sDN As String: sDN = ReverseDN(oSignerCertificate.SubjectName)
    Dim sPKCS10 As String: sPKCS10 = GenerateSelfSignedCertRequest(sDN, sEKU)
    Dim oSignedData As CAPICOM.SignedData: Set oSignedData = New CAPICOM.SignedData
    Dim oUt As CAPICOM.Utilities: Set oUt = New CAPICOM.Utilities
    oSignedData.Content = oUt.Base64Decode(sPKCS10)
    Dim oSigner As CAPICOM.Signer: Set oSigner = New CAPICOM.Signer
    oSigner.Certificate = oSignerCertificate
    oSigner.Options = CAPICOM.CAPICOM_CERTIFICATE_INCLUDE_END_ENTITY_ONLY
    GenerateRenewalCertRequest = oSignedData.Sign(oSigner)
End Function

Private Sub UpdateCert()
    Dim oStore As CAPICOM.Store: Set oStore = New CAPICOM.Store: oStore.Open
    Dim oCertificates As CAPICOM.Certificates
    Set oCertificates = oStore.Certificates.Select("DocSamples", "Выберите сертификат для обновления:")
    
    Dim oCertificate As CAPICOM.Certificate: Set oCertificate = oCertificates.Item(1)
    MsgBox GenerateRenewalCertRequest(oCertificate, "1.3.6.1.5.5.7.3.4, 1.3.6.1.5.5.7.3.2, 1.2.643.2.2.34.6, 1.3.6.1.4.1.33760.1")
End Sub

Function GenerateSelfSignedCertRequest(ByVal sDN As String, ByVal sEKU As String) As String
    Dim oEnroll As XENROLLLib.CEnroll
    Set oEnroll = New XENROLLLib.CEnroll
    oEnroll.ProviderType = PROV_GOST_2001_DH
    oEnroll.ProviderName = "Crypto-Pro GOST R 34.10-2001 Cryptographic Service Provider"
    oEnroll.KeySpec = AT_KEYEXCHANGE
    GenerateSelfSignedCertRequest = oEnroll.createPKCS10(sDN, sEKU)
End Function