Delphi NFC Programming with PaSoRi (RC-S3800): Read and Write Strings and URLs
For those who want to read and write text or URLs to NFC cards (NTAG215) using Delphi.
In this article, we explain in detail how to create a class (TSCard) that handles NDEF-format data—readable directly by smartphones—using the PaSoRi RC-S380 and Windows API, and how to read and write to NTAG215 cards from Delphi.
A key feature of NFC tags is that they can be read without requiring an app: Android supports both text and URLs, while iPhone supports URLs only.
Using the easy-to-handle Delphi units “api.winscard.pas” and “NFCCard.pas,” we introduce step-by-step procedures with sample code for implementing read/write operations compatible with NTAG215 cards.
For details on the specifications of NFC cards (NXP NTAG215), Windows API functions related to card readers, and NDEF (NFC Data Exchange Format),
please refer to Reading and Writing NFC Cards (NXP NTAG215) with PaSoRi and Delphi.
Create a Project
Launch Delphi, then from the menu click “File” ⇒ “New” ⇒ “Windows VCL Application - Delphi (W)”.
Place 2 × TButton, 2 × TLabel, and 3 × TMemo components on the form.
Save the project and units via [File] ⇒ [Save All].
Add a Unit
Click [File] ⇒ [New] ⇒ [Unit] to add a new unit.
Copy and paste the following source code, then save it as “api.winscard.pas”.
unit api.winscard;
interface
uses Winapi.Windows,System.SysUtils,System.Math;
type
SCARDCONTEXT=ULONG;
PSCARDCONTEXT=^SCARDCONTEXT;
SCARDHANDLE = ULONG;
PSCARDHANDLE = ^SCARDHANDLE;
SCARD_IO_REQUEST = Record
dwProtocol :DWORD;
cbPciLength :DWORD;
end;
PSCARD_IO_REQUEST=^SCARD_IO_REQUEST;
// Connect to the Smart Card Resource Manager
Function SCardEstablishContext(
dwScope:DWORD;
pvReserved1:Pointer;
pvReserved2: Pointer;
phContext :PSCARDCONTEXT
):LONG; stdcall; external 'Winscard.dll';
// Release context
Function SCardReleaseContext(
hContext:SCARDCONTEXT
):LONG; stdcall; external 'Winscard.dll';
// Get list of card readers
Function SCardListReadersA(
hContext : SCARDCONTEXT;
mszGroups:PAnsiChar;
szReaders:PAnsiChar;
pcchReaders:PDWORD
):LONG; stdcall; external 'Winscard.dll';
// Get list of card readers
Function SCardListReadersW(
hContext : SCARDCONTEXT;
mszGroups:PWideChar;
szReaders:PWideChar;
pcchReaders:PDWORD
):LONG; stdcall; external 'Winscard.dll';
// Connect to card
Function SCardConnectA(
hContext : SCARDCONTEXT;
szReaders:PAnsiChar;
dwShareMode : DWORD;
dwPreferredProtocols : DWORD;
phCard : PSCARDHANDLE;
pdwActiveProtocols:PDWORD
):LONG; stdcall; external 'Winscard.dll';
// Connect to card
Function SCardConnectW(
hContext : SCARDCONTEXT;
szReaders:PWideChar;
dwShareMode : DWORD;
dwPreferredProtocols : DWORD;
phCard : PSCARDHANDLE;
pdwActiveProtocols:PDWORD
):LONG; stdcall; external 'Winscard.dll';
// Disconnect card
Function SCardDisconnect(
hCard : SCARDHANDLE;
dwDisposition :DWORD
):LONG; stdcall; external 'Winscard.dll';
// Get card status
Function SCardStatusA(
hCard : SCARDHANDLE;
szReaderNames :PAnsiChar;
pcchReaderLen : PDWORD;
pdwState :PDWORD;
pdwProtocol :PDWORD;
pbATR :PBYTE;
pcbAtrLen :PDWORD
):LONG; stdcall; external 'Winscard.dll';
Function SCardStatusW(
hCard : SCARDHANDLE;
szReaderNames :PWideChar;
pcchReaderLen : PDWORD;
pdwState :PDWORD;
pdwProtocol :PDWORD;
pbATR :PBYTE;
pcbAtrLen :PDWORD
):LONG; stdcall; external 'Winscard.dll';
// Send service request and receive data from card
Function SCardTransmit(
hCard : SCARDHANDLE;
pioSendPci :PSCARD_IO_REQUEST;
pbSendBuffer :PByte;
cbSendLength :DWORD;
pioRecvPci :PSCARD_IO_REQUEST;
pbRecvBuffer :PByte;
pcbRecvLength:PDWORD
):LONG; stdcall; external 'Winscard.dll';
const
// Smart card return values
ERROR_BROKEN_PIPE =$00000109;
SCARD_E_BAD_SEEK =$80100029;
SCARD_E_CANCELLED =$80100002;
SCARD_E_CANT_DISPOSE =$8010000E;
SCARD_E_CARD_UNSUPPORTED =$8010001C;
SCARD_E_CERTIFICATE_UNAVAILABLE=$8010002D;
SCARD_E_COMM_DATA_LOST =$8010002;
SCARD_E_DIR_NOT_FOUND =$80100023;
SCARD_E_DUPLICATE_READER =$8010001B;
SCARD_E_FILE_NOT_FOUND =$80100024;
SCARD_E_ICC_CREATEORDER =$80100021;
SCARD_E_ICC_INSTALLATION =$80100020;
SCARD_E_INSUFFICIENT_BUFFER=$80100008;
SCARD_E_INVALID_ATR =$80100015;
SCARD_E_INVALID_CHV =$8010002A;
SCARD_E_INVALID_HANDLE =$80100003;
SCARD_E_INVALID_PARAMETER=$80100004;
SCARD_E_INVALID_TARGET =$80100005;
SCARD_E_INVALID_VALUE =$80100011;
SCARD_E_NO_ACCESS =$80100027;
SCARD_E_NO_DIR =$80100025;
SCARD_E_NO_FILE =$80100026;
SCARD_E_NO_KEY_CONTAINER =$80100030;
SCARD_E_NO_MEMORY =$80100006;
SCARD_E_NO_PIN_CACHE =$80100033;
SCARD_E_NO_READERS_AVAILABLE=$8010002E;
SCARD_E_NO_SERVICE =$8010001D;
SCARD_E_NO_SMARTCARD =$8010000C;
SCARD_E_NO_SUCH_CERTIFICATE=$8010002C;
SCARD_E_NOT_READY =$80100010;
SCARD_E_NOT_TRANSACTED =$80100016;
SCARD_E_PCI_TOO_SMALL =$80100019;
SCARD_E_PIN_CACHE_EXPIRED=$80100032;
SCARD_E_PROTO_MISMATCH =$8010000F;
SCARD_E_READ_ONLY_CARD =$80100034;
SCARD_E_READER_UNAVAILABLE=$80100017;
SCARD_E_READER_UNSUPPORTED=$8010001A;
SCARD_E_SERVER_TOO_BUSY =$80100031;
SCARD_E_SERVICE_STOPPED =$8010001E;
SCARD_E_SHARING_VIOLATION=$8010000B;
SCARD_E_SYSTEM_CANCELLED =$80100012;
SCARD_E_TIMEOUT =$8010000A;
SCARD_E_UNEXPECTED =$8010001F;
SCARD_E_UNKNOWN_CARD =$8010000D;
SCARD_E_UNKNOWN_READER =$80100009;
SCARD_E_UNKNOWN_RES_MNG =$8010002B;
SCARD_E_UNSUPPORTED_FEATURE=$80100022;
SCARD_E_WRITE_TOO_MANY =$80100028;
SCARD_F_COMM_ERROR =$80100013;
SCARD_F_INTERNAL_ERROR =$80100001;
SCARD_F_UNKNOWN_ERROR =$80100014;
SCARD_F_WAITED_TOO_LONG =$80100007;
SCARD_P_SHUTDOWN =$80100018;
SCARD_S_SUCCESS =$00000000;
SCARD_W_CANCELLED_BY_USER=$8010006E;
SCARD_W_CACHE_ITEM_NOT_FOUND=$80100070;
SCARD_W_CACHE_ITEM_STALE =$80100071;
SCARD_W_CACHE_ITEM_TOO_BIG=$80100072;
SCARD_W_CARD_NOT_AUTHENTICATED=$8010006F;
SCARD_W_CHV_BLOCKED =$8010006C;
SCARD_W_EOF =$8010006D;
SCARD_W_REMOVED_CARD =$80100069;
SCARD_W_RESET_CARD =$80100068;
SCARD_W_SECURITY_VIOLATION=$8010006A;
SCARD_W_UNPOWERED_CARD =$80100067;
SCARD_W_UNRESPONSIVE_CARD=$80100066;
SCARD_W_UNSUPPORTED_CARD =$80100065;
SCARD_W_WRONG_CHV =$8010006B;
// dwScope for SCardEstablishContext
// Database operations are executed within the user's domain
SCARD_SCOPE_USER=0;
// Context is the current terminal context,
// Database operations are executed within the terminal's domain
// (Calling application must have appropriate permissions for database actions.)
SCARD_SCOPE_TERMINAL=1;
// Context is the system context,
// Database operations are executed within the system's domain
// (Calling application must have appropriate permissions for database actions.)
SCARD_SCOPE_SYSTEM=2;
// dwShareMode for SCardConnectA, SCardConnectW
SCARD_SHARE_EXCLUSIVE =1;
SCARD_SHARE_SHARED =2;
SCARD_SHARE_DIRECT =3;
// dwPreferredProtocols for SCardConnectA, SCardConnectW
SCARD_PROTOCOL_UNDEFINED =$00000000;
SCARD_PROTOCOL_T0 =$00000001;
SCARD_PROTOCOL_T1 =$00000002;
SCARD_PROTOCOL_RAW =$00010000;
SCARD_PROTOCOL_DEFAULT =$80000000;
// dwDisposition for SCardDisconnect
SCARD_LEAVE_CARD =$00000000;
SCARD_RESET_CARD =$00000001;
SCARD_UNPOWER_CARD =$00000002;
SCARD_EJECT_CARD =$00000003;
// pioSendPci for SCardTransmit
SCARD_PCI_T0 : SCARD_IO_REQUEST = (dwProtocol:1; cbPciLength:8);
SCARD_PCI_T1 : SCARD_IO_REQUEST = (dwProtocol:2; cbPciLength:8);
implementation
end.
Add Another Unit
Click [File] ⇒ [New] ⇒ [Unit] to add another new unit.
Copy and paste the following source code, then save it as “NFCCard.pas”.
unit NFCCard;
interface
uses Winapi.Windows, System.SysUtils, System.Math, System.Classes,
api.winscard;
type
TSCardDataType=(cdtString,cdtUrl);
TSCardData=class(TObject)
private
fData:TBytes;
public
function getData():string;virtual;abstract;
procedure setData(v:string);virtual;abstract;
function getDataType():TSCardDataType;virtual;abstract;
constructor Create();virtual;abstract;
destructor Destroy();override;
property Data:TBytes read fData write fData;
end;
TSCardString=class(TSCardData)
private
fString:String;
public
function getData():string;override;
procedure setData(v:string);override;
function getDataType():TSCardDataType;override;
constructor Create();override;
destructor Destroy();override;
public
end;
TSCardUrl=class(TSCardData)
fUrl:String;
public
function getData():string;override;
procedure setData(v:string);override;
function getDataType():TSCardDataType;override;
constructor Create();override;
destructor Destroy();override;
end;
TSCard = class(TObject)
private
fReader: String; // Reader name
fErr: LONG; // Error code
fErrStr: String; // Error message
fContext: SCARDCONTEXT; // Context for the reader
fHCard: SCARDHandle; // Card connection
fProtocol: DWORD;
fSendPci: SCARD_IO_REQUEST;
fATR: TBytes;
fUID: TBytes;
fCardName: String;
fDataList: TList;
// Infer card name from ATR
procedure GetCardName();
// Read specified block (0–134) (4*135=540 bytes)
// Blocks 0–3 and 130–134 (total 9 blocks = 36 bytes) are locked
// Usable area: 540–36=504 bytes (blocks 4–129)
function ReadBlock(BlockNum: Byte): TBytes;
// Assumes card is connected; write 4 bytes
function UpdateBuffer4Byte(BlockNum: Byte; Data: TBytes): Boolean;
function UpdateBuffer(Data: TBytes; BlockNum: Byte): Boolean;
// Connect to reader
function ConnectReader(): Boolean;
// Disconnect reader (release context)
procedure DisConnectReader();
// After calling ConnectReader, connect to card
function ConnectCard(): Boolean;
// Disconnect card
procedure DisConnectCard();
public
property ErrStr: String read fErrStr;
property Err: LONG read fErr;
property ATR: TBytes read fATR;
property UID: TBytes read fUID;
property Reader: String read fReader;
property DataList: TList read fDataList;
constructor Create;
destructor Destroy(); override;
// Get ATR
procedure GetATR();
// Get UID
procedure GetUID();
// Get UID as text
function GetUIDAsText(): String;
// Read information from card
function Read(): Boolean;
// Write information to card
function Write(): Boolean;
// Clear stored data
procedure ClearDataList();
end;
implementation
{ TSCard }
constructor TSCard.Create;
begin
fReader := ''; // Reader name
fErr := 0;
fErrStr := '';
fContext := 0; // Context for the reader
fHCard := 0;
fCardName := '';
fDataList := TList.Create;
end;
destructor TSCard.Destroy;
var i: Integer;
begin
// Release context
self.DisConnectReader();
for i := 0 to fDataList.Count - 1 do
TSCardData(fDataList[i]).Free;
fDataList.Free;
end;
procedure TSCard.DisConnectCard;
begin
if fHCard <> 0 then
begin
// Disconnect card
SCardDisconnect(fHCard, SCARD_LEAVE_CARD);
fHCard := 0;
end;
end;
procedure TSCard.DisConnectReader;
begin
if fContext<>0 then
begin
SCardReleaseContext(fContext);
fContext:=0;
fReader:='';
fHCard:=0;
fCardName:='';
//SetLength(Self.fATR,0);
//SetLength(Self.fUID,0);
end;
end;
procedure TSCard.GetATR();
var AtrLen: DWORD;
ReadersLen, State: DWORD;
begin
if ConnectCard() then
begin
AtrLen := 32;
SetLength(fATR, AtrLen);
fErr := SCardStatusW(
fHCard, PChar(fReader), @ReadersLen, @State,
@fProtocol,
@fATR[0], @AtrLen
);
if fErr = SCARD_S_SUCCESS then
begin
SetLength(fATR, AtrLen);
self.GetCardName(); // Also retrieve card type name
end
else
begin
SetLength(fATR, 0);
fErrStr := 'Failed to obtain ATR';
end;
// Disconnect card
DisConnectCard;
// Release context
self.DisConnectReader();
end;
end;
procedure TSCard.GetCardName;
begin
if Length(fATR)<15 then
fCardName:='UnKnown'
else if (fATR[13]=$00) and (fATR[14]=$01) then
fCardName:='MIFARE Classic 1K'
else if (fATR[13]=$00) and (fATR[14]=$02) then
fCardName:='MIFARE Classic 4K'
else if (fATR[13]=$00) and (fATR[14]=$03) then //64Byte
fCardName:='MIFARE Ultralight'
else if (fATR[13]=$00) and (fATR[14]=$26) then
fCardName:='MIFARE Mini'
else if (fATR[13]=$00) and (fATR[14]=$3A) then //540Byte
fCardName:='MIFARE Ultralight C'
else if (fATR[13]=$00) and (fATR[14]=$36) then
fCardName:='MIFARE Plus SL1 2k'
else if (fATR[13]=$00) and (fATR[14]=$37) then
fCardName:='MIFARE Plus SL1 4k'
else if (fATR[13]=$00) and (fATR[14]=$38) then
fCardName:='MIFARE Plus SL2 2k'
else if (fATR[13]=$00) and (fATR[14]=$39) then
fCardName:='MIFARE Plus SL2 4k'
else if (fATR[13]=$00) and (fATR[14]=$30) then
fCardName:='Topaz and Jewel'
else if (fATR[13]=$00) and (fATR[14]=$3B) then
fCardName:='FeliCa'
else if (fATR[13]=$FF) and (fATR[14]=$28) then
fCardName:='JCOP 30'
else if (fATR[13]=$00) and (fATR[14]=$07) then
fCardName:='SRIX'
else
fCardName:='UnKnown';
end;
procedure TSCard.GetUID();
var SendLen, RecvLen: DWORD;
SendBuf, RecvBuf: TBytes;
begin
self.fErrStr := '';
self.fErr := 0;
if ConnectCard() then
begin
SendLen := 5;
SetLength(SendBuf, SendLen);
SendBuf[0] := $FF; // CLA
SendBuf[1] := $CA; // INS
SendBuf[2] := $00; // P1 $00: Get UID $01: Get ATS
SendBuf[3] := $00; // P2
SendBuf[4] := $00; // Le
RecvLen := 256;
SetLength(RecvBuf, RecvLen);
ZeroMemory(RecvBuf, RecvLen);
fErr := SCardTransmit(
fHCard, @fSendPci, @SendBuf[0], SendLen, nil, @RecvBuf[0], @RecvLen
);
if fErr = SCARD_S_SUCCESS then
begin
SetLength(RecvBuf, RecvLen);
if (RecvBuf[RecvLen-2] = $90) and (RecvBuf[RecvLen-1] = $00) then
begin
SetLength(fUID, Length(RecvBuf));
move(RecvBuf[0], fUID[0], Length(RecvBuf));
end
else
begin
fErrStr := Format(
'SW1:%2.2x SW2:%2.2x',
[RecvBuf[RecvLen-2], RecvBuf[RecvLen-1]]
);
end;
end
else
begin
fErrStr := 'Failed to obtain UID';
end;
// Disconnect card
SCardDisconnect(fHCard, SCARD_LEAVE_CARD);
fHCard := 0;
// Release context
self.DisConnectReader();
end;
end;
function TSCard.GetUIDAsText: String;
var i:Integer;
begin
result:='';
for i := Low(fUID) to High(fUID) do
result:=result+IntToHex(fUID[i],2);
end;
function TSCard.Read: Boolean;
var i: Integer;
Buf, b: TBytes;
Bufs: TBytes;
rec: Integer;
// DataLen: Integer;
flag: Boolean;
scd: TSCardData;
st: string;
begin
if not ConnectCard then
begin
result := False;
exit;
end;
self.ClearDataList();
Result := true;
SetLength(Bufs, 504);
ZeroMemory(@Bufs[0], 504);
// Read specified blocks (0–134) (4*135=540 bytes)
// Blocks 0–3 and 130–134 (total 9 blocks = 36 bytes) are locked
// Usable area: 540–36=504 bytes (blocks 4–129)
for i := 4 to 129 do
begin
Buf := ReadBlock(i);
move(Buf[0], Bufs[(i-4)*4], 4);
end;
DisConnectCard;
if Bufs[0] = $03 then
begin
if Bufs[1] = 0 then
begin
// Empty
self.fErr := -1;
self.fErrStr := 'Data is empty';
end
else
begin
setLength(Buf, Bufs[1]);
move(Bufs[2], Buf[0], Bufs[1]);
rec := 0;
flag := true;
while flag do
begin
if Buf[rec+3] = ord('T') then
begin
if (Buf[rec+4] = $02) and
(Buf[rec+5] = ord('j')) and (Buf[rec+6] = ord('a')) then
begin
setlength(b, Buf[rec+2]-3);
move(Buf[rec+4+3], b[0], Length(b));
st := TEncoding.UTF8.GetString(b);
scd := TSCardString.Create;
scd.setData(st);
self.fDataList.Add(scd);
end;
end
else if Buf[rec+3] = ord('U') then
begin
setlength(b, Buf[rec+2]-1);
move(Buf[rec+4+1], b[0], Length(b));
st := TEncoding.UTF8.GetString(b);
{ $00=N/A $01=http://www. $02=https://www. $03=http://
$04=https:// $05=tel: $06=mailto: }
if Buf[rec+4] = $01 then
st := 'http://www.' + st
else if Buf[rec+4] = $02 then
st := 'https://www.' + st
else if Buf[rec+4] = $03 then
st := 'http://' + st
else if Buf[rec+4] = $04 then
st := 'https://' + st
else if Buf[rec+4] = $05 then
st := 'tel://' + st
else if Buf[rec+4] = $06 then
st := 'mailto://' + st;
scd := TSCardUrl.Create;
scd.setData(st);
self.fDataList.Add(scd);
end;
flag := not((Buf[rec] and $40) = $40);
rec := rec + 4 + Buf[rec+2];
end;
end;
self.fErr := 0;
self.fErrStr := '';
end
else
begin
// Not in NDEF format
self.fErr := -1;
self.fErrStr := 'Not in NDEF format';
end;
end;
function TSCard.ReadBlock(BlockNum: Byte): TBytes;
var res: DWORD;
SendLen, RecvLen: DWORD;
SendBuf, RecvBuf: TBytes;
begin
if fHCard = 0 then exit;
SetLength(Result, 4);
ZeroMemory(Result, 4);
SendLen := 255;
SetLength(SendBuf, SendLen);
ZeroMemory(@SendBuf[0], SendLen);
SendBuf[0] := $FF; // CLA
SendBuf[1] := $B0; // INS FFB0: ReadBinary
SendBuf[2] := $00; // P1
SendBuf[3] := BlockNum;// P2
SendBuf[4] := $04; // Le number of bytes to read
RecvLen := 255;
SetLength(RecvBuf, RecvLen);
ZeroMemory(@RecvBuf[0], RecvLen);
Res := SCardTransmit(
fHCard, @fSendPci,
@SendBuf[0], SendLen,
nil,
@RecvBuf[0], @RecvLen
);
if Res = SCARD_S_SUCCESS then
begin
SetLength(RecvBuf, RecvLen);
// If the last two bytes are “$90$00”, the read was successful
if (RecvBuf[RecvLen-2] = $90) and (RecvBuf[RecvLen-1] = $00) then
begin
// Reads 16 bytes (4 blocks), but only returns one block (4 bytes)
Move(Recvbuf[0], Result[0], 4);
end;
end;
end;
function TSCard.UpdateBuffer(Data: TBytes; BlockNum: Byte): Boolean;
var i: Integer;
d: TBytes;
WriteBlockNum: Byte;
len: Integer;
begin
self.fErr := 0;
self.fErrStr := '';
Result := False;
if not self.ConnectCard() then
begin
exit;
end;
if Length(Data) = 0 then exit;
SetLength(d, 4);
for i := 0 to (Ceil(Length(Data)/4) - 1) do
begin
ZeroMemory(@d[0], 4);
len := Length(Data) - i*4;
if len > 4 then len := 4;
Move(Data[i*4], d[0], len);
WriteBlockNum := BlockNum + i;
result := self.UpdateBuffer4Byte(WriteBlockNum, d);
if result = false then
begin
break;
end;
end;
self.DisConnectCard();
end;
function TSCard.UpdateBuffer4Byte(BlockNum: Byte; Data: TBytes): Boolean;
var len: Integer;
d: TBytes;
SendLen, RecvLen: DWORD;
SendBuf, RecvBuf: TBytes;
begin
Result := False;
len := Length(Data);
if len = 0 then exit;
if len > 4 then len := 4;
SetLength(d, 4);
ZeroMemory(d, 4);
Move(Data[0], d[0], len);
SendLen := 9;
SetLength(SendBuf, SendLen);
SendBuf[0] := $FF; // CLA
SendBuf[1] := $D6; // INS FFD6: Update Binary
SendBuf[2] := $00; // P1
SendBuf[3] := BlockNum; // P2 Block number 4 or higher
SendBuf[4] := $04; // Lc fixed write length of 4 bytes
SendBuf[5] := d[0]; // Write data
SendBuf[6] := d[1]; // Write data
SendBuf[7] := d[2]; // Write data
SendBuf[8] := d[3]; // Write data
RecvLen := 256;
SetLength(RecvBuf, RecvLen);
fErr := SCardTransmit(
self.fHCard, @self.fSendPci,
@SendBuf[0], SendLen,
nil,
@RecvBuf[0], @RecvLen
);
if fErr = SCARD_S_SUCCESS then
begin
SetLength(RecvBuf, RecvLen);
// If the last two bytes are “$90$00”, the write was successful
if (RecvBuf[RecvLen-2] = $90) and (RecvBuf[RecvLen-1] = $00) then
result := True;
end
else
begin
fErrStr := Format(
'SW1:%2.2x SW2:%2.2x',
[RecvBuf[RecvLen-2], RecvBuf[RecvLen-1]]
);
end;
end;
function TSCard.Write(): boolean;
var buf: TBytes;
i, ct: Integer;
dl: TSCardData;
PayLength: Integer;
begin
if not ConnectCard then
begin
result := False;
exit;
end;
if fDataList.Count = 0 then
begin
SetLength(buf, 3);
buf[0] := $03; // NDEF identifier, start of TLV
buf[1] := $00; // Length in bytes
buf[2] := $FE; // Terminal TLV
end
else
begin
PayLength := 0;
for i := 0 to fDataList.Count - 1 do
begin
dl := fDataList[i];
// MB: $80 Message Begin
// ME: $40 Message End
// CF: $20 Chunk Flag (payload continues in next record)
// SR: $10 Short Record (payload length ≤ 255 bytes)
// IL: $08 ID Length (ID length field exists)
// TNF: $01 Type Name Format (record type)
// If only one record: $D1
// First record: $91, middle: $11, last: $51
dl.fData[0] := $11;
if i = 0 then
dl.fData[0] := dl.fData[0] or $80;
if i = (fDataList.Count - 1) then
dl.fData[0] := dl.fData[0] or $40;
PayLength := PayLength + Length(dl.fData);
end;
SetLength(buf, 2 + PayLength + 1);
ct := 0;
buf[ct] := $03; // NDEF identifier, start of TLV
inc(ct);
buf[ct] := PayLength; // Length in bytes
inc(ct);
for i := 0 to fDataList.Count - 1 do
begin
dl := fDataList[i];
move(dl.fData[0], buf[ct], Length(dl.fData));
inc(ct, Length(dl.fData));
end;
buf[ct] := $FE; // Terminal TLV
end;
Result := self.UpdateBuffer(buf, 4); // Write starting from block 4
end;
procedure TSCard.ClearDataList;
var i:Integer;
begin
for i := (fDataList.Count-1) downto 0 do
begin
TSCardData(fDataList.Items[i]).Free;
fDataList.Delete(i);
end;
end;
function TSCard.ConnectCard: Boolean;
var ActiveProtocols: DWORD;
begin
result := False;
if ConnectReader() then
begin
fErr := SCardConnectW(
fContext, PChar(fReader), SCARD_SHARE_SHARED,
SCARD_PROTOCOL_T0 or SCARD_PROTOCOL_T1, @fHCard, @ActiveProtocols
);
if fErr = SCARD_S_SUCCESS then
begin
if (ActiveProtocols and SCARD_PROTOCOL_T1) > 0 then
begin
fProtocol := SCARD_PROTOCOL_T1;
fSendPci := SCARD_PCI_T1;
end
else
begin
fProtocol := SCARD_PROTOCOL_T0;
fSendPci := SCARD_PCI_T0;
end;
result := True;
end
else
begin
fErrStr := 'No card found in the card reader';
// Release context
self.DisConnectReader();
end;
end
else
begin
fErrStr := 'Card reader not found';
// Release context
self.DisConnectReader();
end;
end;
function TSCard.ConnectReader: Boolean;
var Readers: String;
ReadersLen: DWORD;
begin
result := False;
fReader := ''; // Reader name
fErr := $00;
fErrStr := '';
if fHCard <> 0 then
DisConnectCard;
if fContext <> 0 then
DisConnectReader;
// Connect to the Smart Card Resource Manager
fErr := SCardEstablishContext(SCARD_SCOPE_USER, nil, nil, @fContext);
if fErr = SCARD_S_SUCCESS then
begin
ReadersLen := 255;
SetLength(Readers, ReadersLen);
// Retrieve list of readers
fErr := SCardListReadersW(fContext, nil, PChar(Readers), @ReadersLen);
if fErr = SCARD_S_SUCCESS then
begin
SetLength(Readers, ReadersLen);
// Get the name of the first reader in the list
fReader := Readers;
result := True;
end
else
begin
fErrStr := 'Card reader not found';
// Release context
self.DisConnectReader();
end;
end
else
begin
fErrStr := 'Unknown error';
fContext := 0;
end;
end;
{ TSCardData }
destructor TSCardData.Destroy;
begin
inherited;
end;
{ TSCardString }
constructor TSCardString.Create;
begin
end;
destructor TSCardString.Destroy;
begin
inherited;
end;
function TSCardString.getData: string;
begin
result:=fString;
end;
function TSCardString.getDataType: TSCardDataType;
begin
result:=TSCardDataType.cdtString;
end;
procedure TSCardString.setData(v: string);
var barr: TBytes;
DataLen: Byte;
i: Integer;
begin
fString := v;
barr := TEncoding.UTF8.GetBytes(fString);
DataLen := Length(barr); // Length of UTF-8 byte array
SetLength(fdata, 4 + 3 + DataLen);
// fdata[0] := 4 + 3 + DataLen; // Total record length = record header + language code + text length
// MB: $80 Message Begin
// ME: $40 Message End
// CF: $20 Chunk Flag (payload continues in next record)
// SR: $10 Short Record (payload length ≤ 255 bytes)
// IL: $08 ID Length (ID length field exists)
// TNF: $01 Type Name Format (record type)
// If only one record: $D1
// First record: $91, middle: $11, last: $51
fdata[0] := $D1; // MB ME SR TNF
fdata[1] := $01; // Record type $00: Empty $01: Well-Known ...
fdata[2] := DataLen + 3; // Payload length (★)
fdata[3] := Ord('T'); // Payload type Text:$54 Uri:$55
fdata[4] := $02; // ★ Language code length = 2
fdata[5] := Ord('j'); // ★ j
fdata[6] := Ord('a'); // ★ a
for i := Low(barr) to High(barr) do
fdata[7+i] := barr[i]; // ★ Text string
end;
{ TSCardUrl }
constructor TSCardUrl.Create;
begin
end;
destructor TSCardUrl.Destroy;
begin
inherited;
end;
function TSCardUrl.getData: string;
begin
result:=fUrl;
end;
function TSCardUrl.getDataType: TSCardDataType;
begin
result:=TSCardDataType.cdtUrl;
end;
procedure TSCardUrl.setData(v: string);
var barr: TBytes;
DataLen: Byte;
i: Integer;
begin
fUrl := v;
barr := TEncoding.UTF8.GetBytes(fUrl);
DataLen := Length(barr); // Length of UTF-8 byte array
SetLength(fdata, 4 + 1 + DataLen);
// fdata[0] := 4 + 1 + DataLen; // Total record length = record header + type + string length
// MB: $80 Message Begin
// ME: $40 Message End
// CF: $20 Chunk Flag (payload continues in next record)
// SR: $10 Short Record (payload length ≤ 255 bytes)
// IL: $08 ID Length (ID length field exists)
// TNF: $01 Type Name Format (record type)
// If only one record: $D1
// First record: $91, middle: $11, last: $51
fdata[0] := $D1; // MB ME SR TNF
fdata[1] := $01; // Record type $00: Empty $01: Well-Known ...
fdata[2] := DataLen + 1; // Payload length (★)
fdata[3] := Ord('U'); // Payload type Text:$54 Uri:$55
{ $00=N/A $01=http://www. $02=https://www. $03=http://
$04=https:// $05=tel: $06=mailto: }
fdata[4] := $00; // ★ URL type
for i := Low(barr) to High(barr) do
fdata[5+i] := barr[i]; // ★ String
end;
end.
Enter the Source Code for Form (Unit1)
Write the following source code in Form1’s OnCreate, OnDestroy, Button1 OnClick, and Button2 OnClick events.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls
,NFCCard;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
sc: TSCard;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var i: Integer;
scd: TSCardData;
begin
Memo1.Clear;
Memo2.Clear;
if sc.Read then
begin
Memo3.Lines.Add(sc.Reader);
sc.GetATR();
sc.GetUID();
Memo3.Lines.Add('UID:' + sc.GetUIDAsText());
for i := 0 to sc.DataList.Count - 1 do
begin
scd := TSCardData(sc.DataList[i]);
if scd.getDataType = TSCardDataType.cdtString then
Memo1.Lines.Add(scd.getData)
else
Memo2.Lines.Add(scd.getData)
end;
Memo3.Lines.Add('Read successful');
end
else
begin
Memo3.Lines.Add('Error: ' + sc.ErrStr);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var d: TSCardData;
i: Integer;
begin
sc.ClearDataList;
for i := 0 to Memo1.Lines.Count - 1 do
begin
d := TSCardString.Create;
d.setData(Memo1.Lines[i]);
sc.DataList.Add(d);
end;
for i := 0 to Memo2.Lines.Count - 1 do
begin
d := TSCardUrl.Create;
d.setData(Memo2.Lines[i]);
sc.DataList.Add(d);
end;
if sc.Write then
begin
Memo3.Lines.Add('Write successful');
end
else
begin
Memo3.Lines.Add('Write failed');
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
sc := TSCard.Create;
Label1.Caption := 'String:';
Label2.Caption := 'URL:';
Memo1.Clear;
Memo2.Clear;
Memo3.Clear;
Memo1.ScrollBars := ssBoth;
Memo2.ScrollBars := ssBoth;
Memo3.ScrollBars := ssBoth;
Button1.Caption := 'Read';
Button2.Caption := 'Write';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(sc);
end;
end.
Execution
Connect the PaSoRi (RC-S3800) to your PC and place the IC tag on it.
Press the “Run” button in the Delphi IDE to execute.
Click Button1 to read the card if a string and URL have been registered. The UID will also be read.
Enter the string you want to register in Memo1 and the URL in Memo2, then click Button2 to register them on the IC card.
