Option Explicit

 Const CADES_BES = 1
 Const CADES_DEFAULT = 0
 Const CAPICOM_ENCODE_BASE64 = 0
 Const CAPICOM_CURRENT_USER_STORE = 2
 
 ' Укажите правильный серийный номер сертификата.
 Dim sSerialNumber : sSerialNumber = "13213132"
 ' Укажите правильный адрес службы штампов времени.
 Dim sTSAAddress : sTSAAddress = "http://domain/tsp/tsp.srf"

 Dim oSigner
 Set oSigner = CreateObject("CAdESCOM.CPSigner")
 oSigner.Certificate = GetSignerCertificate(sSerialNumber)
 
 Dim oSignedData
 Set oSignedData = CreateObject("CAdESCOM.CadesSignedData")
 oSignedData.Content = "Some very significant message"

 Dim sSignedData
 ' Создание и проверка подписи CAdES BES
 sSignedData = oSignedData.SignCades(oSigner, CADES_BES, False, CAPICOM_ENCODE_BASE64)
 oSignedData.VerifyCades sSignedData, CADES_BES, False

 ' Создание параллельной подписи CAdES X Long Type 1
 sSignedData = oSignedData.CoSignCades(oSigner, CADES_DEFAULT, CAPICOM_ENCODE_BASE64)
 
 ' Проверка полученных параллельных подписей на соответствие CAdES BES
 oSignedData.VerifyCades sSignedData, CADES_BES, False

 ' Дополнение подписи CAdES BES до подписи CAdES X Long Type 1 (вторая
 ' подпись остается без изменения, так как она уже CAdES X Long Type 1)
 sSignedData = oSignedData.EnhanceCades(CADES_DEFAULT, sTSAAddress, CAPICOM_ENCODE_BASE64)

 ' Проверка полученных параллельных подписей на соответствие CAdES X Long Type 1
 oSignedData.VerifyCades sSignedData, CADES_DEFAULT, False
 
 Function GetSignerCertificate(SerialNumber)
   Set GetSignerCertificate = Nothing
   Dim oCert
   Dim oStore
   Set oStore = CreateObject("CAPICOM.Store")
   oStore.Open CAPICOM_CURRENT_USER_STORE
   For Each oCert In oStore.Certificates
     If (oCert.SerialNumber = SerialNumber) Then
       Set GetSignerCertificate = oCert
       Exit For
     End If
   Next
 End Function

 Function CreateFile (sFileName, sContent)
   Dim fso
   Set fso = CreateObject("Scripting.FileSystemObject")
   Dim NewFile
   Set NewFile = fso.CreateTextFile(sFileName, True)
   NewFile.WriteLine(sContent)
   NewFile.Close
 End Function

' Укажите правильный серийный номер сертификата.
Dim sSerialNumber : sSerialNumber = "13213132"