Delphi XE5 で、FeliCa IDm を読む

下のサンプルコードで、 nanaco カード、ENEOS カード の IDm (カードごとに違う製造ID) が読めました。
Amazon などで、無地のカードが購入できますので、何かに使えそうです。


カードのリーダ/ライタは、デバイスマネージャーでは、「近接通信デバイス」 として認識されます。
※最近のノートパソコンでは、標準で、FeliCa ポート がついているものがあります。

■スクリーンショット
接続されているリード/ライタは、内蔵と外付けのもの、2個認識されています。


■ソースコード
 ※株式会社ソフテック様 「非接触ICカード技術"FeliCa(フェリカ)"のIDm読み取り方法」を、ほぼそのまま、Delphi に書き換えています。感謝!
 ※WinSCard.pas は、こちら

unit Unit3;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm3 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

// WinSCard.pas(Copyright (C) 1996 Microsoft Corporation.)が必要
uses WinSCard;

// PC/SC(Personal Computer / Smart Card)インターフェイス規格
// 参照:EternalWindows http://eternalwindows.jp/security/scard/scard00.html
// 情報元:株式会社ソフテック http://www.softech.co.jp/mm_140205_pc.htm

// FeliCa 製造ID(IDm)読み取り
procedure TForm3.Button1Click(Sender: TObject);
const
  SCARD_S_SUCCESS = 0;
  SCARD_PROTOCOL_T0 = $0001;
  SCARD_PROTOCOL_T1 = $0002;

var
	hContext: LongInt;
	hCard : LongInt;
  ActiveProtocol : DWORD;
  AutoAllocate : LongInt;
  lResult : LongInt;

  ReaderLen : LongInt;
  State : LongInt;
  AtrLen : LongInt;
  Atr : array[0..63] of BYTE;
  SendCommand : array [0..4] of BYTE;
  RecvBuffer : array [0..255] of BYTE;
  ResponseSize : DWORD;
  ReaderName :array [0..255] of WideChar;

  i, j : integer;
  s : string;
  sl : TStringList;
begin
  Edit1.Text := '';
  Edit2.Text := '';
  Edit3.Text := '';
  Memo1.Lines.Clear;

  // 送信コマンド
  // カードのIDmを取得するためのGetDataコマンド
  SendCommand[0] := $FF;
  SendCommand[1] := $CA;
  SendCommand[2] := $00;
  SendCommand[3] := $00;
  SendCommand[4] := $00;

  ReaderLen := sizeof( ReaderName );
  ResponseSize := sizeof(RecvBuffer);

  // リソースマネージャ(Smart Card Resouce Manager)に接続し、ハンドルを取得
  lResult := SCardEstablishContext( SCARD_SCOPE_USER, nil, nil, @hContext );
  if lResult = SCARD_S_SUCCESS  then begin
    // リソースマネージャのハンドル
    Edit1.Text := IntToHex(hContext, 8);

    // 配列を初期化
    FillMemory(@ReaderName, SizeOf(ReaderName), 0);

    // PCに接続されているPC/SC対応のリーダ/ライタの一覧を取得
    // リーダー/ライターの名称を取得
    // この名称は、カードに接続する関数を呼び出す場合に必要
    // mszGroups : nil = SCARD_ALL_READERS と同じ
    lResult := SCardListReadersW( hContext, SCARD_ALL_READERS{ nil}, @ReaderName, AutoAllocate);
    if lResult = SCARD_S_SUCCESS then begin
      sl := TStringList.Create;
      try
        // FeliCa ポートがあるパソコンのため
        // 複数接続されているリーダ/ライタの名称を切り分け
        s := '';
        for i := 0 to Length(ReaderName) -2 do begin
          if (ReaderName[i] <> #00) then s := s + ReaderName[i]
          else begin
            sl.Add(s);
            if (ReaderName[i+1] <> #00) then s := ''
            else break;
          end;
        end;
        // 接続されているリーダ/ライタの名称を表示
        Memo1.Lines.Assign(sl);

        if sl.Count > 0 then begin
          for i := 0 to sl.Count -1 do begin
            for j := 0 to Length(sl[i]) - 1 do ReaderName[j] := sl[i][j+1];
            ReaderName[Length(sl[i])] := #00;

            // リーダ/ライタの名称
            Edit2.Text := String(ReaderName);

            // リーダ/ライタに接続されたカードに接続
            lResult := SCardConnectW( hContext, @ReaderName, SCARD_SHARE_SHARED,
              SCARD_PROTOCOL_T0 or SCARD_PROTOCOL_T1, hCard, @ActiveProtocol );

            if lResult = SCARD_S_SUCCESS  then begin

              // カードの状態、プロトコル、ATRを取得
              lResult := SCardStatusW( hCard, nil, ReaderLen, State, @ActiveProtocol, nil, AtrLen);
              if lResult = SCARD_S_SUCCESS  then begin
                lResult := SCardStatusW( hCard, ReaderName, ReaderLen, State, @ActiveProtocol, @Atr, AtrLen);

                if lResult = SCARD_S_SUCCESS then begin
                  // FeliCaカードであるかの判断
                  if( Atr[13] = $00) and (Atr[14] = $3B ) then begin
                    // カードにコマンドを送信し、データを受信
                    // 送信コマンド:APDU(Application Protocol Data Unit)と呼ばれるバイナリデータ
                    lResult := SCardTransmit( hCard, nil , @SendCommand, sizeof(SendCommand), nil,
                      @RecvBuffer, @ResponseSize );
                    if (lResult = SCARD_S_SUCCESS ) then begin
                      s := '';
                      // 8バイトのバイト列(製造者コード:2バイト + カード識別番号:6バイト)
                      for j := 0 to ResponseSize - 3 do s := s + IntToHex(RecvBuffer[j], 2) + ' ';
                      // カードの製造ID(IDm)
                      Edit3.Text := s;
                      Break;
                    end;
                  end;
                end;
              end;
            end;
            // カードとの通信を切断
            SCardDisconnect( hCard, SCARD_LEAVE_CARD );
          end;
        end;
      finally
        sl.Free;
      end;
    end;
  end;

  // リソースマネージャを解放
  SCardReleaseContext( hContext );

end;

end.