unit DemoMain;
////////////////////////////////////////////////////////////////////////////////
//
//              ДЕМОНСТРАЦИОННАЯ ПРОГРАММА ДЛЯ PR-x08.DLL
//
//        Показано использование практически всех функций библиотеки
//
////////////////////////////////////////////////////////////////////////////////

                            interface
////////////////////////////////////////////////////////////////////////////////
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls, ExtCtrls, Menus, AppEvnts;

type
  TfrmMain = class(TForm)
    btnRefresh: TBitBtn;
    sbrStatus: TStatusBar;
    lbxReaders: TListBox;
    btnOpenReader: TBitBtn;
    btnCloseReader: TBitBtn;
    btnBeep: TBitBtn;
    btnBeepCfg: TBitBtn;
    cbxBeepOnCard: TCheckBox;
    cbxLedOnCard: TCheckBox;
    Bevel1: TBevel;
    grbReaderInfo: TGroupBox;
    btnGetInfo: TBitBtn;
    memInfo: TMemo;
    edtCardNumber: TEdit;
    Label1: TLabel;
    lblCardType: TLabel;
    rgrNumberType: TRadioGroup;
    MainMenu1: TMainMenu;
    miFile: TMenuItem;
    miHelp: TMenuItem;
    miFileExit: TMenuItem;
    miHelpAbout: TMenuItem;
    ApplicationEvents: TApplicationEvents;
    cbxUseWiegand26: TCheckBox;
    procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
    procedure miHelpAboutClick(Sender: TObject);
    procedure miFileExitClick(Sender: TObject);
    procedure rgrNumberTypeClick(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnOpenReaderClick(Sender: TObject);
    procedure btnCloseReaderClick(Sender: TObject);
    procedure btnBeepClick(Sender: TObject);
    procedure btnBeepCfgClick(Sender: TObject);
    procedure btnGetInfoClick(Sender: TObject);
    procedure cbxUseWiegand26Click(Sender: TObject);
  private
    { Private declarations }
    ReaderOpened: boolean;

    function ShowStatus(ACode: integer): integer;
    procedure MsgSelectReader;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

                           implementation
////////////////////////////////////////////////////////////////////////////////
{$R *.DFM}
uses
  //DLL_Main,
  PRx08,
  PRTypes,
  ErrCodes,
  ErrMsg,
  About;

var
  res: short;
  CurDesc: pchar;

////////////////////////////////////////////////////////////////////////////////
function TfrmMain.ShowStatus(ACode: integer): integer;
begin
  sbrStatus.Panels[2].Text := 'Код = ' + IntToStr(ACode) + ' / ' +
    ErrMsgText(ACode);
  Result := ACode;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  // Создали поток чтения карт (неактивным)
  GetMem(CurDesc, MAX_DESC_LEN);
  lbxReaders.Clear;
  btnRefreshClick(Self);
  ReaderOpened := false;
  cbxUseWiegand26.Visible := false;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FreeMem(CurDesc);
end;

////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.miFileExitClick(Sender: TObject);
begin
  Application.Terminate;
end;

////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.miHelpAboutClick(Sender: TObject);
begin
  frmAbout.ShowModal;
end;

////////////////////////////////////////////////////////////////////////////////
//           Просим выбрать ридер в списке
////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.MsgSelectReader;
begin
  ShowMessage('Для выполнения операции выберите считыватель из списка');
end;

////////////////////////////////////////////////////////////////////////////////
//           Обновляем список доступных сейчас ридеров
////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.btnRefreshClick(Sender: TObject);
var
  n: integer;
begin
  // Приостановили поток
  lbxReaders.Clear;
  Application.ProcessMessages;
  n := Enumerate();
  sbrStatus.Panels[0].Text := 'Found ' + IntToStr(n);
  if ShowStatus(GetFirstReader(pbytearray(CurDesc), MAX_DESC_LEN)) = RES_OK then begin
    // Показали первый
    lbxReaders.Items.Add(CurDesc + ' - closed');
    // и попробовали вычерпать остальные
    while (GetNextReader(pbytearray(CurDesc), MAX_DESC_LEN) = RES_OK) do begin
      lbxReaders.Items.Add(CurDesc + ' - closed');
    end;
    lbxReaders.ItemIndex := 0;
  end;
  // Почистили номер карты
  edtCardNumber.Text := '';
  lblCardType.Caption := '';
  ReaderOpened := false;
end;

////////////////////////////////////////////////////////////////////////////////
//           Отрабатывает переключение принудительного W-26
////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.cbxUseWiegand26Click(Sender: TObject);
begin
  if cbxUseWiegand26.Checked then begin
    SetWiegand26(1);
  end else begin
    SetWiegand26(0);
  end;
end;

////////////////////////////////////////////////////////////////////////////////
//           Открываем ридер, который выбран в списке
////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.btnOpenReaderClick(Sender: TObject);
var
  n: integer;
  s: string;
begin
  n := lbxReaders.ItemIndex;
  if n >=0 then begin
    res := ShowStatus(OpenReader(n));
    if res = RES_OK then begin
      s := lbxReaders.Items[n];
      System.Delete(s, length(s) - 8, 9);
      s := s + ' - OPENED';
      lbxReaders.Items[n] := s;
      // Сконфигурировали индикацию на активную:
      SetBeepBlinkMode(n, short(cbxLedOnCard.Checked), short(cbxBeepOnCard.Checked));
      ReaderOpened := true;
    end;
  end else
    MsgSelectReader;
end;

////////////////////////////////////////////////////////////////////////////////
//           Закрываем ридер, который выбран в списке
////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.btnCloseReaderClick(Sender: TObject);
var
  n: integer;
  s: string;
begin
  n := lbxReaders.ItemIndex;
  if n >=0 then begin
    // Закрываем
    res := ShowStatus(CloseReader(n));
    s := lbxReaders.Items[n];
    System.Delete(s, length(s) - 8, 9);
    s := s + ' - closed';
    lbxReaders.Items[n] := s;
    ReaderOpened := false;
  end else
    MsgSelectReader;
  // Почистили номер карты
  edtCardNumber.Text := '';
  lblCardType.Caption := '';
  memInfo.Lines.Clear;
end;

////////////////////////////////////////////////////////////////////////////////
//                   Бикаем и мигаем на считывателе
////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.btnBeepClick(Sender: TObject);
var
  n: integer;
begin
  n := lbxReaders.ItemIndex;
  if n >=0 then begin
    ShowStatus(BeepBlink(n));
  end else
    MsgSelectReader;
end;

////////////////////////////////////////////////////////////////////////////////
//                  Конфигурация индикации на считывателе
////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.btnBeepCfgClick(Sender: TObject);
var
  n: integer;
  l, b: short;
begin
  n := lbxReaders.ItemIndex;
  if n >=0 then begin
    if (cbxBeepOnCard.Checked) then
      b := 1
    else
      b := 0;
    if (cbxLedOnCard.Checked) then
      l := 1
    else
      l := 0;
    ShowStatus(SetBeepBlinkMode(n, l, b));
  end else
    MsgSelectReader;
end;

////////////////////////////////////////////////////////////////////////////////
//                  Получение информации о считывателе
////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.btnGetInfoClick(Sender: TObject);
var
  n: integer;
  inf: array[0..READER_INFO_SIZE] of byte;   // Размер не менее 16 байтов!

  // Утилиты конвертации кодов в строки
  function ModeToStr(m: byte): string;
  begin
    case m of
      R_MODE_ISO14443A   : result := 'ISO-14443A';
      R_MODE_ISO14443B   : result := 'ISO-14443B';
      R_MODE_RFU_1       : result := '<RFU 1>';
      R_MODE_RFU_2       : result := '<RFU 2>';
      R_MODE_MIFARE      : result := 'Mifare';
      R_MODE_EM          : result := 'EM Marin';
      R_MODE_HID         : result := 'HID';
      R_MODE_DALLASS     : result := 'Dallass';
      R_MODE_EM_HID      : result := 'EM - HID';
    else
      result := 'Unknown';
    end;
  end;

  // Выход передатчика ридера
  function RfToStr(rf: byte): string;
  begin
    case rf of
      0  : result := 'off';
      1  : result := 'Low';
      2  : result := 'HIGH';
    else
      result := '???';
    end;
  end;

  // Тип интерфейса
  function InterfToStr(i: byte): string;
  { Функция только проверяет на USB !!! }
  begin
    if (i and $20) <> 0 then
      result := 'USB'
    else
      result := 'no USB';
  end;

begin // =======================================================================
  n := lbxReaders.ItemIndex;
  memInfo.Lines.Clear;
  if n >=0 then begin
    if ShowStatus(GetReaderInfo(n, @inf)) = RES_OK then begin
      // Расшифровываем информацию (что хотим):
      memInfo.Lines.Add('Reader:    ' + ModeToStr(inf[13]));
      memInfo.Lines.Add('Version:   ' + char(inf[9]) + '.' + char(inf[10]));
      memInfo.Lines.Add('RF State:  ' + RfToStr(inf[14]));
      memInfo.Lines.Add('Interface: ' + InterfToStr(inf[11]));
    end;
  end else
    MsgSelectReader;
end;


////////////////////////////////////////////////////////////////////////////////
//                Переключение режима чтения карт
////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.rgrNumberTypeClick(Sender: TObject);
begin
  // Почистили номер карты
  edtCardNumber.Text := '';
  lblCardType.Caption := '';
  if rgrNumberType.ItemIndex = 0 then
    cbxUseWiegand26.Visible := true
  else
    cbxUseWiegand26.Visible := false;
end;


////////////////////////////////////////////////////////////////////////////////
//           Если счиытватель открыт, то здесь читаем код карты
////////////////////////////////////////////////////////////////////////////////
procedure TfrmMain.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
var
  n: integer;
  ctp: short;
  ccode: array[0..8] of byte;
  len: short;
  code: DWORD;
  CardNumStr: string;

  function CardTypeToStr(ct: short): string;
  begin
    case ct of
      1: result := 'ISO14443A';
      2: result := 'EM Marin';
      3: result := 'HID';
      4: result := 'Dallas';
      5: result := 'ChecPoint';
    else
      result := '<unknown>';
    end;
  end;

begin
  if ReaderOpened then begin
    // Получаем номер ридера
    n := lbxReaders.ItemIndex;
    if n >=0 then begin
      // Определяем, что читать - полный код или 4 байта
      case rgrNumberType.ItemIndex of
        1: // Полный код карты
          if ShowStatus(ReadCardNumberRaw(n, ctp, @ccode, len)) = RES_OK then begin
            CardNumStr := '';
            for n := 0 to len - 1 do
              CardNumStr := CardNumStr + IntToHex(ccode[n], 2) + ' ';
            edtCardNumber.Text := CardNumStr;
            lblCardType.Caption := 'Card Type: ' + CardTypeToStr(ctp);
          end;
      else // 4 байба кода
        if ShowStatus(ReadCardNumber(n, code)) = RES_OK then begin
          // Для wiegand-26 показываем 4 байта, но в старшем нули
          CardNumStr := IntToHex(((code shr 24) and $0000FF), 2) + ' ' +
               IntToHex(((code shr 16) and $0000FF), 2) + ' ' +
               IntToHex(((code shr 8) and $0000FF), 2) + ' ' +
               IntToHex((code and $0000FF), 2);
          edtCardNumber.Text := CardNumStr;
          lblCardType.Caption := '';
        end;
      end;
    end;
  end;

  for n := 0 to 5 do begin
    Application.ProcessMessages;
    Sleep(50);
  end;
  Done := false;
end;


end.

