PCSC sample in Free Pascal (Lazarus)

Here is a new PCSC sample in Free Pascal language I promised in PC/SC sample in different languages.

Lazarus

From Lazarus web site:

What is Lazarus?
Lazarus is a Delphi compatible cross-platform IDE for Rapid Application Development. It has variety of components ready for use and a graphical form designer to easily create complex graphical user interfaces.

Infintuary Pascal PC/SC Sample

I found a Pascal PC/SC Sample code for PCSC with Lazarus at http://infintuary.org/stpcsc.php.

This program is also available at https://github.com/ccy/pcsc in a more recent version. Unfortunately the more recent version has Windows specific code and can't be used on GNU/Linux. I reported the issue at Fix build on GNU/Linux: CheckOSError() is for Windows.

License

The license is custom but could be enough. From http://infintuary.org/stpcsc.php

The Pascal PC/SC Sample is freeware and can be used for any purpose.
By downloading the Pascal PC/SC Sample you agree to the terms of use.

The terms of use is different from the license available on the github project. For example the terms of use does not explicitly allow modification of the source code, and the use is allowed only for legal purpose. In general it is a bad idea to re-invent a new license text.

Installation

You copy the files MD_Events.pas, MD_PCSC.pas, MD_PCSCDef.pas, MD_PCSCRaw.pas and MD_Tools.pas.

Source code

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  MD_PCSCRaw, MD_PCSCDef, MD_Tools;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AddLogMemo(Msg: string);
  private
    FPCSCRaw: TPCSCRaw;

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  PCSCResult: Dword;
  hContext: THandle;
  SizeReaders: LongWord;
  pReaders: PChar;
  hCard: LongInt;
  dwActiveProtocol: Cardinal;
  pioSendPCI, pioRecvPCI: pSCardIORequest;
  inBuffer : TBytes;
  outBuffer: TBytes;
  outSize: Cardinal;
  i: Integer;
  outString: String;
begin
    FPCSCRaw := TPCSCRaw.Create;
    FPCSCRaw.Initialize;

    // Establish context
    PCSCResult := FPCSCRaw.SCardEstablishContext(SCARD_SCOPE_SYSTEM, nil, nil, hContext);
    if PCSCResult = SCARD_S_SUCCESS
      then AddLogMemo('SCardEstablishContext succeeded.')
      else AddLogMemo('SCardEstablishContext failed: ' + PCSCErrorToString(PCSCResult));

    // List readers
    PCSCResult := FPCSCRaw.SCardListReaders(hContext, nil, nil, SizeReaders);
    if PCSCResult = SCARD_S_SUCCESS
      then AddLogMemo('SCardListReaders succeeded.')
      else AddLogMemo('SCardListReaders failed: ' + PCSCErrorToString(PCSCResult));

    GetMem(pReaders, SizeReaders);
    PCSCResult := FPCSCRaw.SCardListReaders(hContext, nil, pReaders, SizeReaders);
    if PCSCResult = SCARD_S_SUCCESS
      then AddLogMemo('SCardListReaders succeeded.')
      else AddLogMemo('SCardListReaders failed: ' + PCSCErrorToString(PCSCResult));

    // Use the first reader
    AddLogMemo('Using: ' + pReaders);

    // Connect to the card
    hCard := -1;
    dwActiveProtocol := 0;
    PCSCResult := FPCSCRaw.SCardConnect(hContext, pReaders, SCARD_SHARE_SHARED,
      SCARD_PROTOCOL_Tx, hCard, dwActiveProtocol);
    if PCSCResult = SCARD_S_SUCCESS
      then AddLogMemo('SCardConnect succeeded.')
      else AddLogMemo('SCardConnect failed: ' + PCSCErrorToString(PCSCResult));

    // Send Select Applet command
    pioRecvPCI := nil;
    if dwActiveProtocol = SCARD_PROTOCOL_T0
      then pioSendPCI := @SCARDPCIT0
      else pioSendPCI := @SCARDPCIT1;

    inBuffer := HexStringToBuffer('00 A4 04 00 0A A0 00 00 00 62 03 01 0C 06 01');
    outSize := 258;
    SetLength(outBuffer, outSize);
    PCSCResult := FPCSCRaw.SCardTransmit(hCard, pioSendPCI, Pointer(inBuffer),
      length(inBuffer), pioRecvPCI, Pointer(outBuffer), outSize);
    if PCSCResult = SCARD_S_SUCCESS
      then AddLogMemo('SCardTransmit succeeded.')
      else AddLogMemo('SCardTransmit failed: ' + PCSCErrorToString(PCSCResult));

    SetLength(outBuffer, outSize);
    AddLogMemo('Received (' + IntToStr(outSize) + ' bytes): ' + BufferToHexString(outBuffer));

    // Send test command
    inBuffer := HexStringToBuffer('00 00 00 00');
    outSize := 258;
    SetLength(outBuffer, outSize);
    PCSCResult := FPCSCRaw.SCardTransmit(hCard, pioSendPCI, Pointer(inBuffer),
      length(inBuffer), pioRecvPCI, Pointer(outBuffer), outSize);
    if PCSCResult = SCARD_S_SUCCESS
      then AddLogMemo('SCardTransmit succeeded.')
      else AddLogMemo('SCardTransmit failed: ' + PCSCErrorToString(PCSCResult));

    SetLength(outBuffer, outSize);
    AddLogMemo('Received (' + IntToStr(outSize) + ' bytes): ' + BufferToHexString(outBuffer));

    outString := '';
    for i := 0 to outSize -3 do
      outString := outString + chr(outBuffer[i]);
    AddLogMemo(outString);

    // Disconnect
    PCSCResult := FPCSCRaw.SCardDisconnect(hCard, SCARD_LEAVE_CARD);
    if PCSCResult = SCARD_S_SUCCESS
      then AddLogMemo('SCardDisconnect succeeded.')
      else AddLogMemo('SCardDisconnect failed: ' + PCSCErrorToString(PCSCResult));

    // Release context
    PCSCResult := FPCSCRaw.SCardReleaseContext(hContext);
    if PCSCResult = SCARD_S_SUCCESS
      then AddLogMemo('SCardReleaseContext succeeded.')
      else AddLogMemo('SCardReleaseContext failed: ' + PCSCErrorToString(PCSCResult));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TForm1.AddLogMemo(Msg: string);
begin
  Memo1.Lines.Add(Msg);
end;

end.

Remarks

You will have to create a Form with a TMemo widget and a TButton widget. This part of the solution is not described here.

You click on the button and the program executes.

Output

Comments

High level API

I used the low level API provided in file MD_PCSCRaw.pas. These are direct equivalent of the WinSCard API. But a higher level API is also available and is provided in the file MD_PCSC.pas.

Unfortunately I was not able to find a way to get the list of connected readers with the high level API. Maybe I missed something (I am very new to Free Pascal). I reported the issue at make TPCSC.GetPCSCReaderList() a public method.

64-bits and GNU/Linux issue

A much more important issue is that this wrapper does not work on a 64-bits GNU/Linux system. I had to install a Debian system on a i386 CPU to write and test my code.

The problem is that the wrapper uses a Free Pascal type THandle to store the SCARDCONTEXT and SCARDHANDLE types. The problem is that a THandle in 32-bits on a 64-bits CPU but SCARDCONTEXT and SCARDHANDLE are 64-bits types on a 64-bits CPU using GNU/Linux.

The problem comes from the definition of long (DWORD) on a 64-bits CPU. On GNU/Linux a long is 64-bits. But on Windows a long is 32-bits only. If you want to have a 64-bits variable on Windows you need to use the long long type. This is because Linux is LP64 and Windows is LLP64. See 64-bit data models for more details.

The wrapper should work on macOS even on a 64-bits CPU. This is because Apple does not use any DWORD in the WinSCard API but int32_t instead.

I reported the problem at Using THandle for SCARDCONTEXT and SCARDHANDLE is wrong on GNU/Linux.

Windows only?

As I already wrote in the introduction the, more recent, code available at https://github.com/ccy/pcsc is for Windows only. Some work is needed to make it available (again) for macOS and GNU/Linux.

Conclusion

If you use the Free Pascal language and you use Windows then this wrapper can help you.
If your system is not Windows or you want portability on diffrent systems then this wrapper may not be a good choice.