) + ')
';
xml := xml + 'crl: String
): Boolean; 4. Получение даты подписи. По умолчанию при подписании данных ставится дата UTC .. code-block:: delphi function GetDateFromSign(sign: String; out date: TDateTime): Boolean; 5. Проверка по дате подписи актуальность списков CRL. Возвращает: **True** - если есть список и дата удовлетворяет, **False** - нет списка или нужно обновить CRL .. code-block:: delphi function IsCRLOutOfDate(sign: String): Boolean; 6. Функция загружает по заданному адресу CRL список. .. code-block:: delphi function LoadCRLByURL(url: String; out crl: String): Boolean; 7. Обновляет списки отозванных сертификатов и обновляет их по необходимости. Если установлен флаг *bpForce* в **False**, то функция проверяет действие CRL списков и обновляет только по необходимости. Иначе обновляет в любом случае. .. code-block:: delphi function RefreshCRL(sign: String; spLog: String; bpForce: String): Boolean; 8. Проверяет наличие сертификата из подписи в списках отозванных. .. code-block:: delphi function VerifyCertFromSignInCRL(sign: String): Boolean; 9. Проверяет наличие сертификата в списках отозванных по идентификатору сертификата. .. code-block:: delphi function VerifyCertInCRL(CertID: String): Boolean; 10. Отпечаток сертификата в виде строки шестнадцитиричных цифр без пробелов. .. code-block:: delphi function GetThumbprintHexStringByCertID(CertID: String): string; 11. Массив данных сертификата. Возвращается в воде массива байт. .. code-block:: delphi function GetRawDataByCertID(CertID: String): variant array of byte; Пример ^^^^^^ .. code-block:: delphi var MyMessage, Sign, spLog, crl: string; d: DateTime; begin MyMessage := 'Сообщение, которое нужно подписать'; // Откроем диалоговое окно и выберем сертификат для подписи CertID := Cryptor.OpenCertificateDlg; if VarIsNull(CertID) then begin ShowMessage('Сертификат не выбран'); Exit; end; // Проверим цепочку сертификатов if not Cryptor.VerifyCertificate(CertID, spLog) then begin // Сертификат не прошёл проверку ShowMessage(spLog); Exit; end; // По желанию можно обновить список отозванных вручную if not Cryptor.LoadCRLByURL('http://test.ru/my.crl', crl) then begin ShowMessage('Неудалось загрузить CRL'); Exit; end; // Попытка установки CRL if not Cryptor.AddCRLToRoot(crl) then ShowMessage('Не удалось установить список отозванных. Возможно он уже установлен'); // Проверка в списках отозванных if not Cryptor.VerifyCertInCRL(CertID) then begin ShowMessage('Сертификат в списке отозванных'); Exit; end; // Подписание сообщения if not Cryptor.SignMessage(MyMessage, CertID, Sign) then begin ShowMessage('Ошибка при подписании.'); Exit; end; // Получим дату подписания if Cryptor.GetDateFromSign(Sign, d) then ShowMessage('Сообщение подписано ' + DateTimeToStr(d)) else ShowMessage('Не удалось получить дату из подписи'); // Проверка сообщения // Обновим CRL, если это требуется. IsCRLOutOfDate так же используется // в RefreshCRL, если флаг bpForce = False if Cryptor.IsCRLOutOfDate(Sign) then if not Cryptor.RefreshCRL(Sign, spLog, true) then begin ShowMessage('Неудалось обновить списки отозванных'); Exit; end; // Проверка сертификата, которым было подписано сообщение, на отозванность // происзодит при проверке сообщения, но данную проверку можно сделать отдельно if not Cryptor.VerifyCertFromSignInCRL(Sign) then begin ShowMessage('Сертификат, которым было подписано сообщение в списке отозванных'); Exit; end; if not Cryptor.VerifyMessage(MyMessage, Sign, spLog) then begin // Ошибка ShowMessage(spLog); Exit; end else ShowMessage('Подпись подтверждена.'); // Получение отпечатка сертификата CertID := Cryptor.OpenCertificateDlg; thumbPrint := Cryptor.GetThumbprintHexStringByCertID(CertID); ShowMessage('Отпечаток выбранного сертификата = ' + thumbPrint); // Получение массива байт данных сертификата CertID := Cryptor.OpenCertificateDlg; rawData := Cryptor.GetRawDataByCertID(CertID); // красивый вывод на экран, чотбы все нормально уместилось strRawData := 'RawData = ' + #10#13; for i := 0 to length(rawData)-1 do begin strRawData := strRawData + IntToStr(rawData[i]) + ', '; if (i mod 20 = 0) and (i <> 0) then strRawData := strRawData + #10#13; end; ShowMessage(strRawData); end; Перехват нажатия клавиш ~~~~~~~~~~~~~~~~~~~~~~~ Установка перхватчика для всего приложения ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``procedure HookKeyboardKeyDownEvent(Operation: TbtkScriptDataSetOperationObject)`` - Установить перехватчик. В параметре Operation необходимо указать операцию обратного вызова. Данная операция будет вызываться при каждом нажатии клавишы. Перхват можно отключить с помощью ``procedure UnHookKeyboardKeyDownEvent()`` , либо будет снять автоматически при выгрузке метаданных. В приложении можно одновременно установить не более одного перехватчика на нажатие клавиш .При попытке установить перехватчик при уже установленном будет возбуждено исключение. Операция-обработчик вызывается с аргументами в которых передается информация о нажатой клавише: #. VirtualKey - код виртуальной клавиши `MSDN
**Пример создания/инициализации OPOS-устройства**
.. code-block:: delphi
function OPOS_OpenNewDevice(DeviceClass: String; DeviceName: String; Exclusive: Boolean): Variant;
begin
device := CreateOleObject('OPOS.' + DeviceClass);
if device.Open(DeviceName) <> 0 then
Raise('OPOS.' + DeviceClass + '.Open error ' + IntToStr(device.OpenResult));
if Exclusive and (device.ClaimDevice(1000) <> 0) then
begin
Device.Close;
Raise('OPOS.' + DeviceClass + '.ClaimDevice error');
end;
device.DeviceEnabled := True;
if not device.DeviceEnabled then
begin
Device.ReleaseDevice;
Device.Close;
if not Exclusive then
Raise('device not Enabled. May Exclusive needed.')
else
Raise('device not Enabled');
end;
Result := device;
end;
.. code-block:: delphi
device := OPOS_OpenNewDevice('Scanner', 'ScannerName', True);
- Имена классов OPOS устройств можно наблюдать среди зарегистрированных
в системе утилитой "OleView"
- Имена устройств(и настройки) хранятся по пути реестра
"HKEY\_LOCAL\_MACHINE\\SOFTWARE\\OLEForRetail\\ServiceOPOS\\"
ключ ServiceOPOS содержит классы зарегистрированных в системе
устройств, такие как "Scanner".
ключ конкретного типа устройств содержит ключи с Именами
зарегистрированных устройств
В приведённом примере подключается устройство описанное в ключе
"HKEY\_LOCAL\_MACHINE\\SOFTWARE\\OLEForRetail\\ServiceOPOS\\Scanner\\ScannerName"
**Пример завершения работы с OPOS-устройством**
.. code-block:: delphi
procedure CloseDevice(Device: Variant);
begin
Device.DeviceEnabled := False;
Device.ReleaseDevice;
Device.Close;
end;
Пример работы со сканером штрихкодов
.. code-block:: delphi
var events: TbtkScriptComEvents;
begin
Selection.ExecOpScript('CloseScanner');
device := OPOS_OpenNewDevice('Scanner', ScannerDeviceName, True);
events := TbtkScriptComEvents.Create('{CCB90183-B81E-11D2-AB74-0040054C3719}');
events.Connect(device, Selection.OperationByName('OnScanner'));
if not events.Connected then
begin
CloseDevice(device);
Raise('Сканер отверг обработчик событий');
end;
device.DecodeData := True;
device.DataEventEnabled := True;
if Selection.VarExists('StaticScannerVariableName') then
Selection.SetVar('StaticScannerVariableName', events)
else
Selection.AddVar('StaticScannerVariableName', events, ftVariant);
end;
var events: TbtkScriptComEvents;
begin
events := Selection.GetVar('StaticScannerVariableName')
if VarIsNull(events) then
Exit;
CloseDevice(events.ComObject);
events.Disconnect;
Selection.GetVar('StaticScannerVariableName', Null);
end;
Selection.ExecOpScript('CloseScanner');
function ScanDataType2String(AType: Integer): String;
begin
...
end;
begin
try
case ADispID of
1:
begin
ShowMessage('Данные сканирования:
'+ ScanDataType2String(ASender.ScanDataType)+'
'+ ASender.ScanDataLabel);
end;
finally
ASender.DataEventEnabled := True;
end;
end;
**function ScanDataType2String(AType: Integer): String**;
.. code-block:: delphi
begin
case AType of
101: Result := 'Digits';
102: Result := 'Digits';
103: Result := 'EAN 8';
104: Result := 'EAN 13';
105: Result := 'Discrete 2 of 5) Digits';
106: Result := 'Interleaved 2 of 5) Digits';
107: Result := 'Digits, -, $, :, /, ., +; 4 start/stop characters (a, b, c, d)';
108: Result := 'Full ASCII feature';
109: Result := 'Same characters as Code 39';
110: Result := '128 data characters';
111: Result := 'UPC-A with supplemental barcode';
112: Result := 'UPC-E with supplemental barcode';
113: Result := 'UPC-D1';
114: Result := 'UPC-D2';
115: Result := 'UPC-D3';
116: Result := 'UPC-D4';
117: Result := 'UPC-D5';
118: Result := 'EAN 8 with supplemental barcode';
119: Result := 'EAN 13 with supplemental barcode';
120: Result := 'EAN 128';
121: Result := 'OCR "A"';
122: Result := 'OCR "B"';
131: Result := 'Reduced Space Symbology - 14 digit GTIN';
132: Result := 'RSS - 14 digit GTIN plus additional fields';
131: Result := 'GS1 DataBar Omnidirectional (normal or stacked)';
132: Result := 'GS1 DataBar Expanded (normal or stacked)';
133: Result := 'Interleaved 2 of 5 check digit verified and transmitted';
134: Result := 'GS1 DataBar Limited';
135: Result := 'Ames Code';
136: Result := 'Matrix 2 of 5';
137: Result := 'Code 39 with check character verified and transmitted';
138: Result := 'Code 39 with Mod 32 check character';
139: Result := 'Code 39 CIP';
140: Result := 'Tri-Optic Code 39';
141: Result := 'ISBT-128';
142: Result := 'Code 11';
143: Result := 'MSI Code';
144: Result := 'Plessey Code';
145: Result := 'Telepen';
151: Result := 'Composite Component A.';
152: Result := 'Composite Component B.';
153: Result := 'Composite Component C.';
154: Result := 'TLC-39';
201: Result := 'PDF 417';
202: Result := 'Maxicode';
203: Result := 'Data Matrix';
204: Result := 'QR Code';
205: Result := 'Micro QR Code';
206: Result := 'Aztec';
207: Result := 'Micro PDF 417';
208: Result := 'GS1 DataMatrix';
209: Result := 'GS1 QR Code';
210: Result := 'Code 49';
211: Result := 'Code 16K';
212: Result := 'Codablock A';
213: Result := 'Codablock F';
214: Result := 'Codablock 256';
215: Result := 'Han Xin Code';
end else
Result := 'Unknown(' + IntToStr(AType) + ')';
end;
Взаимодействие с последовательным (RS232, RS485) портом
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
В системе Global выполнять чтение из последовательного (COM) порта можно
используя класс TbtkScriptSerialPortObject. Получить объект связанный с
последовательным портом можно через метод
Application.GetSerialPort(APortName: String);
Описание классов
^^^^^^^^^^^^^^^^
TbtkScriptSerialPortObject
''''''''''''''''''''''''''
Методы
""""""
- Close - Закрытие COM порта. На закрытие выполняет освобождение
занятых системных ресурсов, **важно после работы с COM портом закрыть
его**.
- DeregisterHandler - Дерегистрация обработчика на получение данных COM
портом.
- GetCOMMTimeouts: TbtkScriptSerialPortTimeouts - Получение параметров
времение ожидания(timeout) последовательного порта. После изменения
параметров, можно записать в порт используя SetCOMMTimeouts.
- GetDCBProperties: TbtkScriptSerialPortDcbObject - Получение
управляющий настроек порта в виде DCB структуры. С помощью функции
можно получить текущие настройки порта, изменить нужные поля и
записать в порт через SetDCBProperties.
- Open - Открытие COM порта. После открытия порта, можно производить
чтение и запись.
- RegisterHandler(var Operation: TbtkScriptOperationObject) -
Регистрация обработчика на получение данных COM портом.
Зарегестрированная операция будет вызвана, когда устройство
подключенное к COM порту выполнит запись в порт. Обработчик должен
обладать входным параметров строковго типа. Через параметр передается
имя порта из которого получены данные.
- SetCOMMTimeouts(var TimeOuts: TbtkScriptSerialPortTimeouts ) - Запись
параметровов таймаутов в порт. Параметром является структура
COMMTIMEOUTS.
- SetDCBProperties(var DCB: TbtkScriptSerialPortDcbObject) - Запись
управляющей структуры DCB в порт.
Свойства
""""""""
- Data: String - Данные считанные из последовательного порта, после их
поступления. Поле позволяет получить данные в обработкичке на
поступление данных в последовательный порт.
- Port: String - Имя последовательного порта. Свойство только для
чтения
- Opened: boolean; - Возвращает состояние актиности порта. Если true -
порт открыт, false - закрыт.
- Registered: boolean; - Зарегестрирован обработчик на последовательный
порт или нет. True - зарегестрирован, False - незарегестрирован.
TbtkScriptSerialPortDcbObject
'''''''''''''''''''''''''''''
Свойства
""""""""
- BaudRate: Integer; - Для задания значения можно использовать
константы CBR\_110, CBR\_300, CBR\_600, CBR\_1200, CBR\_2400,
CBR\_4800, CBR\_9600, CBR\_14400, CBR\_19200, CBR\_38400, CBR\_56000,
CBR\_57600, CBR\_115200, CBR\_128000, CBR\_256000;
- ByteSize: Integer;
- Parity: Integer; - Для задания значения можно использовать константы
NOPARITY, ODDPARITY, EVENPARITY, MARKPARITY, SPACEPARITY;
- StopBits: Integer; Константы ONESTOPBIT, ONE5STOPBITS, TWOSTOPBITS.
`Описание DCB структуры в msdn `__
TbtkScriptSerialPortTimeouts
''''''''''''''''''''''''''''
Эту структуру лучше, не использовать в режиме аснхронного чтения, когда
вызывается обработчик после чтения порта. Это обусловлденно внутренними
особенностями работы. Кому вдруг интерсенно, то там используется
overlapped режим и Windows нам сообщается о завершение на на входе
записи в ком порт сразу '''блока '''данных. Дальше мы получаем объем
данных в COM порте и под этот объем подготавливаем буфер в который и уже
записываем данные через ReadFile. Timeouts влияет на ReadFile, но в
нашем случае мы в любом случае не прочитаем больше, чем размер
подготовленного буфера. Но все это относиться к асинхронному режиму,
если будет реализован не асинхронный, то структура снова будет на коне.
Свойства
""""""""
- ReadIntervalTimeout: Integer
- ReadTotalTimeoutConstant: Integer
- ReadTotalTimeoutMultiplier: Integer
- WriteTotalTimeoutConstant: Integer
- WriteTotalTimeoutMultiplier: Integer
`Описание Timeouts структуры в msdn `__
Настройки TbtkScriptSerialPortDcbObject и TbtkScriptSerialPortTimeouts
задавать не обязательно, можно использовать значения по умолчанию. В
коде ниже приведен пример как следуюет задавать настройки, а именно в
начале надо получить текущие, затем установить новые пользовательские
значения потом уже эту структуру записать в последовательный порт, тем
самым мы гарантируем, что не перетрем свойства которые не задали в
структуре пустыми значениями.
Пример работы
^^^^^^^^^^^^^
Листинг тестовой операции:
.. code-block:: delphi
ComPortName := GetVar('sSerialPortName');
SerialPort := Application.GetSerialPort(ComPortName); // ComPortName = "COM3"
SerialPort.Open;
// Дальше идет задание настроек, но этот момент можно пропустить
// тогда будут использованы значения по умолчанию
// точно такие же, какие заданы в этом примере
dcb := SerialPort.GetDCBProperties;
dcb.BaudRate := CBR_19200;
dcb.ByteSize := 8;
dcb.Parity := ONESTOPBIT;
dcb.StopBits := NOPARITY;
SerialPort.SetDCBProperties(dcb);
timeouts := SerialPort.GetCOMMTimeouts;
timeouts.ReadIntervalTimeout := 50;
timeouts.ReadTotalTimeoutConstant := 40;
timeouts.ReadTotalTimeoutMultiplier := 40;
timeouts.WriteTotalTimeoutConstant := 40;
timeouts.WriteTotalTimeoutMultiplier := 40;
SerialPort.SetCOMMTimeouts(timeouts);
SerialPort.RegisterHandler(Selection.OperationByName('OnComPortReaded') );
Листинг операции-обработчика OnComPortReaded:
.. code-block:: delphi
SerialPort := Application.GetSerialPort(APortName);
ShowMessage(SerialPort.Data);
Эмулирование COM порта
^^^^^^^^^^^^^^^^^^^^^^
Для теста можно эмулировать COM порт и записывать в него поток данных.
Существуют бесплатные(условно-бесплатные) версии подобных утилит.
Проверенно работает утилита VSPE (VIRTUAL SERIAL PORTS EMULATOR) для
эмуляции виртуального последовательно порта.
Для генерации трафика в цикле можно использовать утилиту AGG Com port data emulator (Freeware).
Сканеры штрих-кодов
~~~~~~~~~~~~~~~~~~~