Пример 5
Данный пример демонстрирует создание и проверку подписи CAdES BES, создание параллельной подписи CAdES X Long Type 1, а также дополнение подписи CAdES BES до подписи CAdES X Long Type 1.
VBScript
Option Explicit
Const CADES_BES = 1
Const CADES_DEFAULT = 0
Const CAPICOM_ENCODE_BASE64 = 0
Const CAPICOM_CURRENT_USER_STORE = 2
' Укажите правильный серийный номер сертификата.
Dim sSerialNumber : sSerialNumber = "12345678000000000000"
' Укажите правильный адрес службы штампов времени.
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("CAdESCOM.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