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

'----------------------------------------------------------------------------------------