Аппаратно-программная реализация считывателей БСК MF-RW-USB (старых и новых годов выпуска)

function W_IO(Address, Cmd: char; BodyLen: integer; const CmdBody; var ReplyLen: integer; var ReplyBuffer): char;

W_SetLogParams(LogCfgPtr: PLogInfo); 
W_GetLogParams(LogCfgPtr: PLogInfo); 
W_SetProtocolParams(ProtocolInfoPtr: PProtocolInfo); 
W_GetProtocolParams(ProtocolInfoPtr: PProtocolInfo);

type
TProtocolInfo = record
DisableAddress: BOOLEAN;
CheckMode: INTEGER;
end;

PProtocolInfo = ^ TProtocolInfo;

W_SetProtocolParams: procedure(ProtocolInfoPtr: PProtocolInfo); stdcall;

W_SetProtocolParams:= LinlProc('W_SetProtocolParams');

procedure TForm1.SetProtocolParams;
const
CHECK_FCS= #$03;
var
PPar: TProtocolInfo;
begin
PPar:= ; // Вот с этим я и не могу разобраться, но если эту строку не прописывать,
//то в запросе получается следующее
// Запрос без W_SetProtocolParams  - FD 3F 30 40 AF FE
// Запрос с   W_SetProtocolParams  - FD 31 40 39 E2 FE
 W_SetProtocolParams(@t)
end;

........
procedure SetProtocolParams;
procedure Read;
........
 
  type
  TProtocolInfo = record
  DisableAddress: BOOLEAN;
  CheckMode: INTEGER;
  end;
  PProtocolInfo = ^ TProtocolInfo;
 
var
PPar: TProtocolInfo;
W_SetProtocolParams: procedure(ProtocolInfoPtr: PProtocolInfo); stdcall;
......
 
//В  const запихал все коды ответы оборудованием
// Коды ошибок при работе с портом
//и Методы расчета контрольной суммы кадра
 
procedure TMain.FormCreate(Sender: TObject);
begin
W_SetProtocolParams:= LinkProc('W_SetProtocolParams');
.....
end;
 
procedure TMain.SetProtocolParams;
begin
 W_SetProtocolParams(@t)
end;
 
procedure TMain.Read;
begin
 W_SetPortParams(@t); // Установка параметров порта
 SetProtocolParams;  // Установка параметров протакола 
begin
 Ret:= W_IO(#$3F, #$03, 0,'', RL, Event); // Запрос (управление энергопотреблением)
 if Ret = REPLY_ACK then
   memo1.Lines.Add('Данные получены')
else
  memo1.Lines.Add('Ошибка');
 end;
  end;

  public
    { Public declarations }
 
    procedure rec(Sender:TObject; Buffer: pointer; BufferLength: Word);
  end;
 
 
uses Comm32;
 
 
{ ----------------------------------------- }
{ ТЕСТ СЫРЫХ ЗАПРОСОВ БЕЗ PROX232.DLL }
{ ----------------------------------------- }
const  brate: array [1..10] of integer = (1200, 2400, 4800, 9600, 19200, 38400, 57600, 115200, 128000, 256000);
       cmprt: array [1..14] of string = ('COM1','COM2','COM3','COM4','COM5','COM6','COM7','COM8','COM9','COM10','COM11','COM12','COM13','COM14');
 
var  com: Tcomm32;
 
procedure TForm1.FormCreate(Sender: TObject);
var i: integer;
begin
 
 // --------------------------------------------------
 decimalseparator:= '.';
 // динамическое создание COMM32
 com:= Tcomm32.Create(self);
 com.OnReceiveData:= rec;
 
 // настройки порта
 com.BaudRate:= 9600; // скорость
 com.StopBits:= 1;    // стоп-бит
 com.Bits    := 8;    // кол-во
 com.CommPort:= 'COM2'; // номер порта
 
 com.StartComm 
end;
 
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 com.StopComm;
 com.free
end;
 
 
type tb = array[1..255] of Char;  //Определяем символьный массив
     pb = ^tb;
     TDataByte = array of word;
 
var buf: array of byte;
    id_kadr: integer;
    crc: byte;
 
procedure TForm1.rec(Sender:TObject; Buffer: pointer; BufferLength: Word);
var PX : pb;
    i  : integer;
    str: string;
begin
 PX:= buffer; str:='';
 
 // ЛОГГИРОВАНИЕ ==============================================================
 for i:= 1 to BufferLength do begin
  str:= str +inttohex(ord(PX^[i]), 2) + ' ';
 end; 
 memo1.Lines.Add(str);
 
 // РАЗБОР КОДОГРАММЫ ===========================
 // Кадр ответа считывателя компьютеру
 //
 // Стартовое условие 1 0xFD
 // Адрес 1 0x00
 // Идентификатор кадра 1  Повторение идентификатора кадра компьютера.
 // Код команды 1  Повторение кода команды компьютера.
 // Данные команды  ХХ  Зависит от команды.
 // Контрольная сумма 1  С поля «Адрес» до поля «Данные»
 // Стоповое условие 1 0xFE
 // ===========================================================================
 
 // При разборе кадра следует придерживаться следующих правил:
 if (ord(PX^[1])= $FD) and // cтартовое условие обладает наивысшим приоритетом
    (ord(PX^[7])= $FE) and // cтоповое условие обладает вторым уровнем приоритета
    (ord(PX^[2])= $1)      // адрес обладает третьим уровнем приоритета
  then begin
 
 
  // Байтстаффинг обладает четвертым уровнем приоритета. Ошибка байтстаффинга в процессе
  // разбора потока есть основание для отбрасывания всего потока до следующего стартового
  // условия.
 
  // Разбор кадра начинается с проверки минимально допустимой длины кадра (длина кадра без поля
  // данных) и его контрольной суммы (ищется как смещение от стопового условия). Все остальные
  // поля ищутся как смещения от стартового условия.
 
 end;
 
 
 
 // end РАЗБОР КОДОГРАММЫ ==================
 
end;

procedure TMain.Read;
 const
 otvet='Есть ответ от ридера...';
 bat = #$00;
 REPLY_OK = #$00;
 REPLY_ACK = #$55;
 REPLY_NACK6 = #$06;
var
  Ret: char;
  RL: integer;
  Event: TEvent;
begin
 Ret := W_IO(#$1, #$45, length(bat), '00', RL, Event);
 if Ret = REPLY_OK then
 memo1.Lines.Add(otvet);
end;

procedure TMain.Read;
begin
 Ret := W_IO(#$1, #$00, 0, '', ReplyLen, ReplyBuffer);
 
if Ret = REPLY_OK then begin
 Edit1.Text:='Команда выполнена успешно, получены данные';
 Edit2.Text:=(ReplyBuffer);
end;
if Ret= REPLY_ACK then begin
 Edit1.Text:='Получен ответ ACK';
 Edit2.Text:=(ReplyBuffer);
end;
if Ret= REPLY_NACK6 then begin
 Edit1.Text:='Получен ответ NACK6';
 Edit2.Text:=(ReplyBuffer);
end;
 end;

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SyncObjs;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    function LinkProc(ProcName: string):Pointer;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  type
  PComInfo = ^ TComInfo;
  TComInfo = record
  RecordSize: DWORD; // Размер структуры, байт
  Port: BYTE; // Номер порта. 1 - COM1 и т.д.
  BaudRate: DWORD; // Скорость обмена
  WaitPortTimeout: DWORD; // Время ожидания доступности порта, мс
  ReadTotalTimeout: DWORD; // Время ожидания ответа считывателя, мс
  ReadNextByteTimeout: DWORD; // Время ожидания поступления очередного
                              // байта при условии, что обнаружено начало
                              // валидного кадра, мс.
  end;
 
  type
  PProtocolInfo = ^ TProtocolInfo;
  TProtocolInfo = record
  DisableAddress: BOOLEAN; // Размер структуры, байт
  CheckMode: INTEGER; // Режим проверки контрольной суммы
  end;
var
  Form1: TForm1;
// набор импортируемых функций
  W_SetPortParams: procedure(PortCfgPtr: PComInfo); stdcall;
  W_SetProtocolParams: procedure(ProtocolInfoPtr: PProtocolInfo); stdcall;
  W_IO: function(Address, Cmd: char;
                 BodyLen: integer;
                 const CmdBody;
                 var ReplyLen: integer;
                 var ReplyBuffer): char; stdcall;
  LibHandle: THandle;
 
  implementation
 
  {$R *.dfm}
 
{ TForm1 }
 
{ TForm1 }
 
function TForm1.LinkProc(ProcName: string): Pointer;
begin
  result:= GetProcAddress(LibHandle,PChar(ProcName));
end;
 
// Подключаем DLL....
procedure TForm1.FormCreate(Sender: TObject);
begin
  LibHandle:= LoadLibrary('dll/ProX232.dll');
  W_SetPortParams:= LinkProc('W_SetPortParams');
  W_SetProtocolParams:= LinkProc('W_SetProtocolParams');
  W_IO:= LinkProc('W_IO');
end;
 
// Устанавливаем параметры порта и создаем подключение....
procedure TForm1.Button1Click(Sender: TObject);
var
  t: TComInfo;
begin
  t.Port:= 3;
  t.BaudRate:= 115200;
  t.WaitPortTimeout:= 200;
  t.ReadTotalTimeout:= 100;
  t.ReadNextByteTimeout:= 50;
  t.RecordSize:= 21; // dword = 4 байтам
  W_SetPortParams(@t)
 end;
 
 // Устанавливаем параметры протакола....
procedure TForm1.Button2Click(Sender: TObject);
var
  Prot: TProtocolInfo;
begin
  Prot.DisableAddress:=true; // Размер структуры, байт
  Prot.CheckMode:=03; // Режим проверки контрольной суммы
  W_SetProtocolParams(@Prot)
end;
 
// Формирем и отправляем запрос....
procedure TForm1.Button3Click(Sender: TObject);
// Описываем константы....
Const
  REPLY_OK = #$0;
  REPLY_ACK = #$55;
var
// Выводим переменные....
  Ret:Char;
  ReplyLen:integer;
  ReplyBuffer:Pointer;
begin
//определяем размер буфера и выделяем под него память....
  ReplyLen:=255;
  ReplyBuffer:=GetMemory(ReplyLen);
// Формируем и отправляем запрос....
  Ret := W_IO(#$1, #$00, 0, '', ReplyLen, ReplyBuffer);
 if Ret = REPLY_OK then
begin
// Выводим ответ от считывателя...
  Edit1.Text:='Команда выполнена успешно, получены данные';
  Edit2.Text:=PChar(ReplyBuffer);
end;
// Освобождаем память...
  FreeMemory(ReplyBuffer);
end;
 
end.