Полезняшки: 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.

OTL на заметку: параллельное выполнение функции в потоках, каждый со своими параметрами

Сама идея:

Запустит несколько паралельных потоков для выполнения некой общей задачи, причем каждый поток должен получить свои параметры для работы. 

Применение на будущее: например одновременно сканирование файлов в нескольких директориях, понятно что имя директории для сканирования для каждого потока должно быть свое. Хоть и алгоритм сканирования общий. 

Демо: передача параметров через блокирующую коллекцию, использование параметров через record (обертка), передаются два параметра частота и длительность, функция выполняющаяся в потоке получает эти параметры и 10 раз проигрывает сигнал с такой частотой и длительностью.

Потоков на запуск 4, работают одновременно 2....

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  OTLParallel, OtlTaskControl, OtlCollections, OtlCommon;

type
  TParametersForProc = record
                        Hz : Integer;
                        Duration : Integer;
                       end;

  TForm3 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Join : IOmniParallelJoin;
    CollectionParams : IOmniBlockingCollection;
  public
    { Public declarations }
    procedure JoinProcExecute;
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure Go(Hz, Duration : Integer);
var
  I: Integer;
begin
 for I := 0 to 10 do
 begin
     Sleep(1000);
     Winapi.Windows.Beep(Hz, Duration);
 end
end;

procedure TForm3.JoinProcExecute;
var
 Value     : TOmniValue;
 ParamProc : TParametersForProc;
begin
 // Взять из коллекции параметры
 CollectionParams.Take(Value);
 // Преобразовать обратно
 ParamProc := Value.Unwrap;
 // Запустить процедуру с переданными  параметрами
 Go(ParamProc.Hz, ParamProc.Duration);
 // вывести параметры
 Memo1.Lines.Add(Format('Hz : %d; duration: %d',[ParamProc.Hz, ParamProc.Duration]));
end;

procedure TForm3.Button1Click(Sender: TObject);
var
 arrayProc : array of TProc;
 I: Integer;
 Value : TOmniValue;
 ParamProc : TParametersForProc;
begin
 CollectionParams := TOmniBlockingCollection.Create;
 SetLength(arrayProc, 4);
 for I := Low(arrayProc) to High(arrayProc) do
 begin
     // Для каждого потока свои параметры, поэтому перед запуском потоков
     // в коллекцию добавляем параметры, функция выполняющаяся в потоке будет
     // брать параметр для себя из коллекции
     ParamProc.Hz       := (I+1) * 1000;
     ParamProc.Duration := (I+1) * 20;
     // обернуть рекорд к TOmniValue
     Value := TOmniValue.Wrap(ParamProc);
     // Добавим в параметры
     CollectionParams.Add(Value);
     arrayProc[i] := JoinProcExecute;
 end;
 CollectionParams.CompleteAdding;       // добавление завершено
 // NumTasks(2) - два потока выполняются одновременно
 Join := Parallel.Join(arrayProc).NumTasks(2).NoWait.Execute; // запуск параллельных потоков
end;

end.

Полезняшки: Использование анонимных методов в Delphi в качестве обработчиков событий....

Сама идея:

Использовать классические обработчики событий, через анонимные методы. То есть сократить количество кода в обработчиках, там где реакцией на событие должно быть исполнение немногих строк кода. 
Например, по событию нужно просто подать сигнал, или вывести сообщение.
Избавиться от объявления процедур обработки в классе, вызывающих замусоривание листинга.

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TOnNotify = reference to procedure; // анонимный метод

  TDemoNotify = class
  private
    fOnNotify: TOnNotify;
  public
   procedure SendNotify;
  published
   property OnNotify : TOnNotify read  fOnNotify write fOnNotify;
  end;

  TfrmNotify = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    demo :  TDemoNotify;
  public
    { Public declarations }
    procedure _onNotify;
  end;

var
  frmNotify: TfrmNotify;

implementation

{$R *.dfm}

{ TDemoNotify }

procedure TfrmNotify.FormCreate(Sender: TObject);
begin
 demo := TDemoNotify.Create;
end;

procedure TfrmNotify.FormDestroy(Sender: TObject);
begin
 if Assigned(demo) then FreeAndNil(demo);
end;

procedure TfrmNotify._onNotify;
begin
 ShowMessage('Сработало классика!');
end;

procedure TDemoNotify.SendNotify;
begin
 if Assigned(fOnNotify) then fOnNotify;
end;


procedure TfrmNotify.Button1Click(Sender: TObject);
begin
 // Классический подход
 demo.OnNotify := _onNotify;
 demo.SendNotify;
end;

procedure TfrmNotify.Button2Click(Sender: TObject);
begin
 // Обработчик через анонимную функцию
 demo.OnNotify :=
  procedure
  begin
   ShowMessage('Сработало анонимная процедура!');
  end;
 demo.SendNotify;
end;

end.

Delphi и Android. Странная бага в TSQLConnection dbExpress .

Решил прикрутить SQLite к программе на андроид.
Делал все как по инструкции Using SQLite (iOS_and_Android), однако когда у свойства Connected
объекта TSQLConnection выставляю True и запускаю прогу на устройство, программа android  уходит в черный экран и зависает до появления предложения ОС Android о закрытии зависшего приложения.

При этом в дизайнере все показывается нормально (я имею ввиду информацию с БД - в List.Item - Дачный дом берется из записи таблицы БД). Если отключить подключение к БД (Connected - False) и запустить приложение то все нормально.
В Deployment тоже все настроено по инструкции:

Код подключения для к БД для Android аналогичный примеру.

procedure TfrmMain.SQLConnectionBeforeConnect(Sender: TObject);
begin
  {$IF DEFINED(iOS) or DEFINED(ANDROID)}
  SQLConnection.Params.Values['ColumnMetadataSupported'] := 'False';
  SQLConnection.Params.Values['Database'] :=
      TPath.Combine(TPath.GetDocumentsPath, 'Ksital.s3db');
  {$ENDIF}
end;

В общем третий день чудеса. Может кто встречался с такой проблемой?

PS. Скриншот с эмулятора. 

Android и Delphi XE. Хранение пользовательских данных Preferens. Аналог INI-файлов Windows

Пользовательские данные в Androide могут хранится либо в пользовательских файлах Preferens либо в БД Sql Lite, либо в обычных файлах  (например на SD-карте). Для начала рассмотрим хранение в пользовательских файлах Preferens поддерживающихся OC Android.Код простой:

unit Main;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Edit, FMX.DateTimeCtrls,
  AndroidApi.Jni.JavaTypes, AndroidApi.Jni.App,
  AndroidApi.Jni.GraphicsContentViewText,
  FMX.Helpers.Android;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    NumberBox1: TNumberBox;
    CalendarEdit1: TCalendarEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    Prefs: JSharedPreferences;
  public
    { Public declarations }
    Procedure Save;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.fmx}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 Save;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  // Cохранение данных. Сначала с помощью метода getSharedPreferences получаем объект sPref класса SharedPreferences,
  // который позволяет работать с данными (читать и писать). Константа MODE_PRIVATE используется для настройки доступа и означает,
  // что после сохранения, данные будут видны только этому приложению.
 
  // MyData - имя файла для хранения данных.
  Prefs  := SharedActivity.getSharedPreferences(StringToJString('MyData'),  TJActivity.JavaClass.MODE_PRIVATE);
 
  Edit1.Text  := JStringToString(Prefs.getString(StringToJString('Edit1'), StringToJString('')));
  NumberBox1.Value := Prefs.getFloat(StringToJString('NumberBox1'), 0);
  CalendarEdit1.Date := StrToDate(
                  JStringToString(Prefs.getString(StringToJString('CalendarEdit1'), StringToJString('10.01.2014'))));
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 Save;
end;
 
procedure TForm1.Save;
var
  Editor: JSharedPreferences_Editor;
begin
  // Чтобы редактировать данные, необходим объект Editor – получаем его из sPref.
  Editor := Prefs.edit;
  Editor.putString(StringToJString('Edit1'), StringToJString(Edit1.Text));
  Editor.putFloat(StringToJString('NumberBox1'), NumberBox1.Value);
  Editor.putString(StringToJString('CalendarEdit1'), StringToJString(DateToStr(CalendarEdit1.Date)));
  Editor.apply;
end;

Помимо getSharedPreferences использовать getPreferences, если хотите не выдумывать имя файла. Имя файла будет задана автоматом по имени текущего окна.
Использовать getSharedPreferences, нужно когда данные - общие для нескольких окон, а также если сами хотите выбирать имя файла для сохранения.

Полезняшки. Shell-расширения для файлов Delphi и Lazarus

Случайно нашел интересный проект http://code.google.com/p/delphi-dev-shell-tools/
который в контекстное меню для файлов .pas, .dpr, .inc, .pp, .dpk, . dproj, .frm, .fmx, .rc  добавляет различные действия сильно облегчающие жизнь Delphi/Lazarus-программисту.
Причем все это гибко настраивается.

Delphi XE5 разработка мобильных приложений. Некоторые заметки для осмысления. (Upd 2)

Некоторые наблюдения по итогам тестовых приложений для Android. Мой взгляд на разработку.