option explicit const CAPICOM_AUTHENTICATED_ATTRIBUTE_SIGNING_TIME = 0 const CAPICOM_CERTIFICATE_INCLUDE_END_ENTITY_ONLY = 2 const CAPICOM_ENCODE_BASE64 = 0 const CAPICOM_CURRENT_USER_STORE = 2 const CAPICOM_STORE_OPEN_READ_ONLY = 0 const test_msg = "Тестирование средств подписи на рабочем месте проведено успешно." const file_name = "niias_test_sign.txt" const msg_box_title = "Генератор тестовой подписи" '======================================================================================== dim cert: set cert = ChoseCert if cert is nothing then MsgBox "Отказ от выбора сертификата", vbInformation, msg_box_title WScript.Quit end if dim signOrError if not SignMsg(cert, signOrError) then MsgBox "Ошибка создания подписи: " & signOrError, vbCritical, msg_box_title WScript.Quit end if dim fileDir: fileDir = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%USERPROFILE%") dim filePath: filePath = fileDir & "\" & file_name with CreateObject("Scripting.FileSystemObject").CreateTextFile(filePath, true) .Write signOrError .Close end with dim mbRes: mbRes = MsgBox("Тестовая подпись записана в следующий файл:" & _ vbNewLine & vbNewLine & filePath & vbNewLine & vbNewLine & _ "Нажмите кнопку ""OK"" для открытия папки, содержащей файл.", _ vbInformation or vbOKCancel, msg_box_title) if mbRes = vbOK then CreateObject("WSCript.shell").Run(fileDir) end if WScript.Quit '======================================================================================== function ErrToString dim errNo: errNo = Err.number dim errSrc: errSrc = Err.Source dim errDesc: errDesc = Err.Description if errNo = 0 then ErrToString = "" else dim errMsg: errMsg = "" if errSrc <> "" then errMsg = errSrc & ": " end if ErrToString = errMsg & "0x" & hex(errNo) & " (" & errNo & ")" & vbNewLine & errDesc end if end function '---------------------------------------------------------------------------------------- function ChoseCert set ChoseCert = nothing dim stor: set stor = CreateObject("CAPICOM.Store.2") stor.Open CAPICOM_CURRENT_USER_STORE, "My", CAPICOM_STORE_OPEN_READ_ONLY dim certs: set certs = stor.Certificates on error resume next set ChoseCert = certs.Select("Сертификаты из локального хранилища пользователя", "Выберите сертификат, которым будет подписано тестовое сообщение:").Item(1) on error goto 0 end function '---------------------------------------------------------------------------------------- function Str2Bin(ByVal msg) dim i, res for i = 1 to len(msg) res = res & ChrB(Asc(Mid(msg, i, 1))) next Str2Bin = res end function '---------------------------------------------------------------------------------------- function SignMsg(ByVal cert, ByRef signOrError) on error resume next dim sign: sign = DoSignMsg(cert) if IsEmpty(sign) then signOrError = ErrToString SignMsg = false else signOrError = sign SignMsg = true end if on error goto 0 end function '---------------------------------------------------------------------------------------- function DoSignMsg(ByVal cert) dim capSignAttr: set capSignAttr = CreateObject("CAPICOM.Attribute.1") capSignAttr.Name = CAPICOM_AUTHENTICATED_ATTRIBUTE_SIGNING_TIME capSignAttr.Value = Now dim capSigner: set capSigner = CreateObject("CAPICOM.Signer.2") capSigner.Options = CAPICOM_CERTIFICATE_INCLUDE_END_ENTITY_ONLY capSigner.Certificate = cert capSigner.AuthenticatedAttributes.Add capSignAttr dim capSignData: set capSignData = CreateObject("CAPICOM.SignedData.1") capSignData.Content = Str2Bin(test_msg) DoSignMsg = capSignData.Sign(capSigner, false, CAPICOM_ENCODE_BASE64) end function '----------------------------------------------------------------------------------------