Полезняшки: CadesCom. Подписание и проверка XML (XMLDSig) по GOST R 34.10-2012 256 bit

unit main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, CAdESCOM_TLB, CAPICOM_TLB, ComObj,
  ActiveX, oleauto, EncdDecd;

Const
 SUBJECT = 'Иванов Иван Иванович';

 CAPICOM_CURRENT_USER_STORE = 2;
 CAPICOM_MY_STORE = 'My';
 CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED = 2;
 CAPICOM_CERTIFICATE_FIND_SUBJECT_NAME = 1;
 CADESCOM_XML_SIGNATURE_TYPE_ENVELOPED = 0;
 CADESCOM_XML_SIGNATURE_TYPE_ENVELOPING = 1;

 // Криптопровайдер: Crypto-Pro GOST R 34.10-2012 Cryptographic Service Provider
 signMethod   = 'urn:ietf:params:xml:ns:cpxmlsec:algorithms:gostr34102012-gostr34112012-256';
 digestMethod = 'urn:ietf:params:xml:ns:cpxmlsec:algorithms:gostr34112012-256';

type
  TForm3 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Procedure AddLog(S : String);
  public
    { Public declarations }
    function GetCertificateBySubjectName(certSubjectName : String) : ICPCertificate;
    function SignCreate(Certificate : ICPCertificate; dataToSign : WideString) : WideString;
    function Verify(SignedMessage : WideString)  : boolean;
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.AddLog(S: String);
begin
 Memo1.Lines.Add(S);
end;

procedure TForm3.Button1Click(Sender: TObject);
var
 Certificate : ICPCertificate;
 fnXMLSource, fnXMLSigned : string;
 SL : TStringList;
begin
 Memo1.Clear;
 Certificate := GetCertificateBySubjectName(SUBJECT);
 if Certificate= nil then Exit;

 fnXMLSource := ExtractFilePath(ParamStr(0)) + 'XML\test_canon.xml';
 fnXMLSigned := ExtractFilePath(ParamStr(0)) + 'XML\test_signed.xml';

 try
   SL := TStringList.Create;
   if FileExists(fnXMLSource) then
   begin
     SL.LoadFromFile(fnXMLSource);
     AddLog('-------------------------------------------------------------------');
     AddLog('XML для подписания');
     AddLog('-------------------------------------------------------------------');
     AddLog(SL.Text);

     SL.Text := SignCreate(Certificate, SL.Text);
     AddLog('-------------------------------------------------------------------');
     AddLog('XML sign');
     AddLog('-------------------------------------------------------------------');
     AddLog(SL.Text);
     SL.SaveToFile(fnXMLSigned);
   end;

   if FileExists(fnXMLSigned) then
   begin
     SL.LoadFromFile(fnXMLSigned);
     AddLog('-------------------------------------------------------------------');
     AddLog('XML проверка подписания');
     AddLog('-------------------------------------------------------------------');
     if Verify(SL.Text) then
        AddLog('Подпись валидна!')
     else
        AddLog('Подпись недействительна!')
   end;
 finally
   if Assigned(SL) then FreeAndNil(SL);
 end;
end;

function TForm3.GetCertificateBySubjectName(certSubjectName : String): ICPCertificate;
var
 Store : CPStore;  //IStore3
 Certificates : ICertificates2;
begin
 Store := CoCPStore.Create;
 Store.Open(CAPICOM_CURRENT_USER_STORE, CAPICOM_MY_STORE, CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED);
 Certificates := Store.Certificates as ICertificates2;
 Certificates.Find(CAPICOM_CERTIFICATE_FIND_SUBJECT_NAME, certSubjectName, True);
 if Certificates.Count = 0 then
 begin
    AddLog('Сертификат не найден: SN=' + certSubjectName);
    Result := nil;
    Exit;
 end
 else
 begin
    AddLog('Сертификат найден: SN=' + certSubjectName);
    Result := IInterface(Certificates.Item[1]) as ICPCertificate;
    AddLog('Валидность: ' + DateToStr(Result.ValidFromDate) + '-' + DateToStr(Result.ValidToDate));
    Store.Close();
 end;
end;

function TForm3.SignCreate(Certificate: ICPCertificate; dataToSign: WideString): WideString;
var
 Signer : ICPSigner;
 SignedXML : ISignedXML;
begin
 // Создаем объект CAdESCOM.CPSigner
 Signer := CoCPSigner.Create;
 Signer.Certificate := Certificate;

 // Создаем объект CAdESCOM.SignedXML
 SignedXML := CoSignedXML.Create;
 SignedXML.Content := dataToSign;
 // Указываем тип подписи - в данном случае вложенная
 SignedXML.SignatureType   := CADESCOM_XML_SIGNATURE_TYPE_ENVELOPED;
 // Указываем алгоритм подписи
 SignedXML.SignatureMethod := signMethod;
 // Указываем алгоритм хэширования
 SignedXML.DigestMethod    := digestMethod;
 try
   Result := SignedXML.Sign(Signer, '');
 except
   on E: Exception do
   begin
      AddLog('Ошибка подписания: ' + E.Message);
   end;
 end;
end;

function TForm3.Verify(SignedMessage : WideString)  : boolean;
var
 SignedXML : ISignedXML;
begin
 // Создаем объект CAdESCOM.SignedXML
 SignedXML := CoSignedXML.Create;
 try
   SignedXML.Verify(SignedMessage,'');
   Result := true;
 except
   on E: Exception do
   begin
      AddLog('Ошибка проверки ЭЦП: ' + E.Message);
      Result := False;
   end;
 end;
end;

end.