Suicaの履歴読み出しソフトをVisual Basicで作ってみた

Suicaの履歴を読み出してみました。開発環境はVisual Basic 2019で、インタフェースはPC/SCです。カードリーダにはSONY RC-S380を使いました。駅コードは、PosgreSQLに入れて、ODBCでアクセスしました。

スポンサーリンク

駅コードをPostgreSQLに登録する

まず、駅コードをPostgreSQLに登録します。

PostgreSQLのインストール方法とODBCの設定については、以下の記事に記しています。

PostgreSQLをインストールしてExcel VBAからアクセスしてみた
データベースがソフトウェアから使えると、自動化の可能性が広がります。今回、PostgreSQLにExcelからアクセスし、SELECT文を実行してみましたので、覚書として記しておきます。接続にはADODBを使いました。Postgre...

もし、DBを使うということが心理的に負担を感じるようでしたら、後に示すプログラムにおいて、DBを使う関数(GetStationName)をコメントアウトし、とりあえず線区コードと駅コードを抽出するまでを第1ステップとしてはいかがでしょうか?

駅コード

僕は、図のようなレコード形式の駅コードデータを使いました。
残念ながら、メジャーだったコード入手先のリンクは切れてしまっているようです。

駅コードのレコード形式

駅コードのレコード形式

PostgreSQLにテーブルを作る

PostgreSQLにテーブルを作ります。

SQL Shell (psql)を立ち上げ、次のSQLを流しました。

CREATE TABLE station_code(
    dist_code       VARCHAR(2) NOT NULL,
    line_code       VARCHAR(2) NOT NULL,
    station_code    VARCHAR(2) NOT NULL,
    company         VARCHAR(60),
    line            VARCHAR(60),
    station         VARCHAR(60),
    PRIMARY KEY (dist_code, line_code, station_code)
    );

事業者名、線区名、駅名の最大文字数は18文字です。僕のPostgreSQLサーバの文字コードはUTF-8であり、日本語1文字は3バイトになるので、VARCHAR(60)としました。

後からマニュアルを読んでみたところ、PostgreSQLの場合は文字長とあり、最低限VARCHAR(18)でいいみたいです。まぁ、大きくしておいても悪さはしません。

駅コードを入力する

駅コードはcsv形式であり、これをExcelで開きました。カラム数は、6(A列~F列)です。

各列ごとにソートしてデータを確認すると、文字化けしているレコードが9行見つかりました。これらは、レコードごと削除しました。

ExcelからPostgreSQLに、レコードを直接登録する方法を知らないので、登録用のSQLを作ります。
先ず、ExcelのG2セルに次のコードを入力しました。

="INSERT INTO station_code VALUES ('"&RIGHT("00"&A2,2)&"','"&RIGHT("00"&B2,2)&"','"&RIGHT("00"&C2,2)&"','"&D2&"','"&E2&"','"&F2&"');"

すると、次のようなINSERT文ができます。

INSERT INTO station_code VALUES ('00','01','01','東日本旅客鉄道','東海道本','東京');

同様にして、全レコードに対するINSERT文を作り、SQL Shell (psql)にコピペすることで、テーブルが完成します。

最終的に5,939レコードが登録されました。もともと5,995レコードあり、文字化けしていたのが9レコードだったので、47レコードが重複していたようです。日本全国の鉄道駅の数って約6,000と覚えればいいですね。

ODBCの確認

Visual BasicからODBCを介してPostgreSQLにアクセスします。この際に使用する名前を確認しておきます。手順は次の通りです。

コントロールパネル → 管理ツール → ODBCデータソース(64 ビット)

ODBC データ ソース (64 ビット)

ODBC データ ソース (64 ビット)

ドライバー欄に「PostgreSQL」と記載されている行の名前欄を確認します。
この図の場合は、「PostgreSQL30」とか「PostgreSQL35W」になります。
それぞれANSI(x64)とUnicode(x64)として用意しましたが、どちらでも使えました。

もし、ドライバー欄に「PostgreSQL」の文字が見当たらない場合は、こちらの記事を参考にして、設定してみてください。

Suica履歴読み出しソフトをVisual Basic 2019で作成する

Visual Basic 2019を立ち上げ、Formの名前をFrmMain.vbとしてから、次のコードを貼り付けます。

Imports System.Data.Odbc
Imports System.Runtime.InteropServices

''' ------------------------------------------------------------------------
''' (summary) Suicaの履歴を読み出す                               (/summary)
''' cf. https://ja.osdn.net/projects/felicalib/wiki/suica
''' ------------------------------------------------------------------------
Public Class FrmMain
    ' ───────────────────────────────────
    ' 列挙型の宣言 
    ' ───────────────────────────────────
    ''' --------------------------------------------------------------------
    ''' (summary) 動作モード                                      (/summary)
    ''' --------------------------------------------------------------------
    Private Enum Mode
        Normal          ' 通常
        ProductSales    ' 物販
        Bus             ' バス
    End Enum

    ' ───────────────────────────────────
    ' 構造体の宣言 
    ' ───────────────────────────────────
    ''' --------------------------------------------------------------------
    ''' (summary) 処理情報の受け渡し用                            (/summary)
    ''' --------------------------------------------------------------------
    Private Structure Transact
        Public strTransact As String    ' 処理内容
        Public enmMode As Mode          ' 動作モード(通常/物販/バス)
    End Structure

    ' ───────────────────────────────────
    ' 本体
    ' ───────────────────────────────────
    ''' --------------------------------------------------------------------
    ''' (summary) Suicaから読み出した1レコードを解析する          (/summary)
    ''' (param name="byt")    バイト配列                            (/param)
    ''' (param name="intLen") 読み出したバイト長                    (/param)
    ''' --------------------------------------------------------------------
    Private Sub AnalyzeRecords(ByVal byt() As Byte, intLen As Integer)
        ' 配列番号に定数名を割り当てる
        Const cstTerminal As Integer = 0
        Const cstTransact As Integer = 1
        'Const cstRfu0 As Integer = 2
        'Const cstRfu1 As Integer = 3
        Const cstDate0 As Integer = 4
        Const cstDate1 As Integer = 5
        Const cstBoardingLine = 6
        Const cstBoardingStation = 7
        Const cstArrivalLine = 8
        Const cstArrivalStation = 9
        Const cstBalance0 As Integer = 10
        Const cstBalance1 As Integer = 11
        Const cstSerial0 As Integer = 12
        Const cstSerial1 As Integer = 13
        Const cstSerial2 As Integer = 14
        Const cstRegion As Integer = 15
        Const cstSW1 As Integer = 16
        Const cstSW2 As Integer = 17
        ' 読み出し成功の場合の戻り値
        Const cstSW1Success As Integer = &H90
        Const cstSW2Success As Integer = &H0

        ' 引数の配列サイズが正常であり、かつ読み出し成功を確認
        If byt.GetUpperBound(0) < cstSW2 Then Exit Sub
        If byt(cstSW1) <> cstSW1Success Or
                byt(cstSW2) <> cstSW2Success Then Exit Sub

        ' 端末種情報を取得する
        Dim strTerminal As String = GetTerminal(byt(cstTerminal))
        ' 処理情報を取得する。同時に動作モードも取得する
        Dim usrTransact As Transact = GetTransact(byt(cstTransact))
        ' 利用日付を取得する
        Dim dteUse As Date = GetDate(byt(cstDate0), byt(cstDate1))
        ' 残高を取得する
        Dim intBalance As Integer =
                byt(cstBalance1) * &H100 + byt(cstBalance0)
        ' 連番を取得する
        Dim strSerial As String =
                $"{byt(cstSerial0).ToString("x2")}-" &
                $"{byt(cstSerial1).ToString("x2")}-" &
                $"{byt(cstSerial2).ToString("x2")}"
        ' 動作モードに従って分岐する
        Select Case usrTransact.enmMode
            Case Mode.Normal        ' 通常使用(鉄道利用)の場合
                ' 乗車駅情報を取得する
                Dim strBoarding As String =
                        GetStationName(byt(cstRegion), byt(cstBoardingLine),
                                byt(cstBoardingStation))
                ' 降車駅情報を取得する
                Dim strArrival As String =
                        GetStationName(byt(cstRegion), byt(cstArrivalLine),
                                byt(cstArrivalStation))
                ' 結果を出力する
                Console.WriteLine($"{strSerial} : {intBalance:#,0} : " &
                        $"{dteUse.ToString("yyyy/MM/dd")} : " &
                        $"{strBoarding} : {strArrival} : " &
                        $"{strTerminal} : {usrTransact.strTransact}")

            Case Mode.Bus           ' バス利用の場合
                ' 降車バス停コードが良くわからないので、その情報を除いて表示
                Console.WriteLine($"{strSerial} : {intBalance:#,0} : " &
                        $"{dteUse.ToString("yyyy/MM/dd")} : " &
                        $"{strTerminal} : {usrTransact.strTransact}")

            Case Mode.ProductSales  ' 物販利用の場合
                ' 利用時刻を取得する
                Dim ts As TimeSpan = GetTime(byt(cstBoardingLine),
                        byt(cstBoardingStation))
                ' 結果を表示する
                Console.WriteLine($"{strSerial} : {intBalance:#,0} : " &
                        $"{dteUse.ToString("yyyy/MM/dd")} : " &
                        $"{ts.ToString("hh\:mm")} : " &
                        $"{strTerminal} : {usrTransact.strTransact}")
            Case Else
        End Select
    End Sub

    ''' --------------------------------------------------------------------
    ''' (summary) 利用日付を取得する                              (/summary)
    ''' (param name="byt0") 0バイト目のデータ                       (/param)
    ''' (param name="byt1") 1バイト目のデータ                       (/param)
    ''' (returns> 利用日付                                        (/returns)
    ''' --------------------------------------------------------------------
    Private Function GetDate(ByVal byt0 As Byte, byt1 As Byte) As Date
        ' 先頭から7ビットが年
        Dim intYear As Integer = 2000 + (byt0 And &HFE) \ &H2
        ' 次の4ビットが月
        Dim intMonth As Integer =
                (byt0 And &H1) * &H8 + (byt1 And &HE0) \ &H20
        ' 残りの5ビットが日
        Dim intDay As Integer = byt1 And &H1F
        Dim dte As Date = Nothing   ' 戻り値の一時保持用
        ' 日付型に変換
        DateTime.TryParse($"{intYear}-{intMonth}-{intDay}", dte)
        ' 戻り値のセット
        Return dte
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary) 駅名を取得する                                  (/summary)
    ''' (param name="bytRegion")  地区コード(この使い方ウソかも)  (/param)
    ''' (param name="bytLine")    路線コード                        (/param)
    ''' (param name="bytStation") 駅コード                          (/param)
    ''' (returns> 駅名情報                                        (/returns)
    ''' --------------------------------------------------------------------
    Private Function GetStationName(
            ByVal bytRegion As Byte,
            ByVal bytLine As Byte,
            ByVal bytStation As Byte) _
            As String
        ' 戻り値保持用の変数を宣言
        Dim strRet As String = ""
        ' ODBCで接続するための文字列を作るオブジェクトをインスタンス
        Dim odbConnStrBldr As New OdbcConnectionStringBuilder()
        ' 管理ツール → ODBCデータソース(64ビット)に登録しているデータソース
        odbConnStrBldr.Dsn = "PostgreSQL30"
        ' ODBCでPostgreSQLに接続する
        Using odbConn As New OdbcConnection(odbConnStrBldr.ToString)
            Try
                odbConn.Open()
            Catch ex As Exception
                ' ここで「ERROR [IM014] [Microsoft][ODBC Driver Manager]
                ' 指定された DSN には、ドライバーとアプリケーションとの
                ' アーキテクチャの不一致が含まれています」というエラーが
                ' 出る場合は、プラットフォームがAny CPUであることが問題
                ' 下行の手順によりx64に変更すればよい
                ' 構成マネージャ → プラットフォーム → 新規作成 → x64
                Console.WriteLine(ex.Message)
                Return ""
            End Try
            ' コマンドオブジェクトをインスタンス
            Dim odbCmd As New OdbcCommand With {.Connection = odbConn}
            ' 社名、線名、駅名を取得するSQL
            '(bytRegionの使い方がウソかもしれない)
            odbCmd.CommandText =
$"  SELECT company, line, station                           " &
$"      FROM station_code                                   " &
$"      WHERE   dist_code    = '{bytRegion.ToString("x2")}' " &
$"          And line_code    = '{bytLine.ToString("x2")}'   " &
$"          And station_code = '{bytStation.ToString("x2")}'"
            ' SQLを実行する
            Try
                Using odbDatRdr As OdbcDataReader = odbCmd.ExecuteReader
                    ' 1行ずつ読み出す
                    While odbDatRdr.Read
                        ' 読み出した内容を文字配列に保存する
                        Dim strArray(odbDatRdr.FieldCount - 1) As String
                        For i = strArray.GetLowerBound(0) To _
                                strArray.GetUpperBound(0)
                            strArray(i) = odbDatRdr.GetValue(i).ToString
                        Next i
                        ' カンマ区切りで連結する
                        strRet &= Join(strArray, ", ") & Environment.NewLine
                    End While
                End Using
            Catch ex As Exception

                Console.WriteLine(ex.Message)
                Return ""
            End Try
        End Using
        ' 最後のvbCrLfを取り除く
        strRet = strRet.Trim
        ' 戻り値をセット
        Return strRet
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary) 端末情報を取得する                              (/summary)
    ''' (param name="byt") 端末情報を表すByte変数                   (/param)
    ''' (returns> 端末情報                                        (/returns)
    ''' --------------------------------------------------------------------
    Private Function GetTerminal(ByVal byt As Byte) As String
        ' Byte変数に対応する端末情報を返す
        Select Case byt
            Case &H3 : Return "精算機"
            Case &H4 : Return "携帯型端末"
            Case &H5 : Return "車載端末"
            Case &H7 : Return "券売機"
            Case &H8 : Return "券売機"
            Case &H9 : Return "入金機"
            Case &H12 : Return "券売機"
            Case &H14 : Return "券売機等"
            Case &H15 : Return "券売機等"
            Case &H16 : Return "改札機"
            Case &H17 : Return "簡易改札機"
            Case &H18 : Return "窓口端末"
            Case &H19 : Return "窓口端末"
            Case &H1A : Return "改札端末"
            Case &H1B : Return "携帯電話"
            Case &H1C : Return "乗継精算機"
            Case &H1D : Return "連絡改札機"
            Case &H1F : Return "簡易入金機"
            Case &H46 : Return "View ALTTE"
            Case &H48 : Return "View ALTTE"
            Case &HC7 : Return "物販端末"
            Case &HC8 : Return "自販機"
            Case Else : Return "不明"
        End Select
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary) 利用時刻を取得する                              (/summary)
    ''' (param name="byt0") 0バイト目のデータ                       (/param)
    ''' (param name="byt1") 1バイト目のデータ                       (/param)
    ''' (returns) 利用時刻                                        (/returns)
    ''' --------------------------------------------------------------------
    Private Function GetTime(ByVal byt0 As Byte, byt1 As Byte) As TimeSpan
        ' 先頭から5ビットが時
        Dim intHour As Integer = (byt0 And &HF8) \ &H8
        ' 次の6ビットが分
        Dim intMinute As Integer =
                (byt0 And &H7) * &H8 + (byt1 And &HE0) \ &H20
        Dim ts As TimeSpan = Nothing
        TimeSpan.TryParse($"{intHour}:{intMinute}", ts)
        Return ts
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary) 処理情報を取得する                              (/summary)
    ''' (param name="byt") 処理情報を表すByte変数                   (/param)
    ''' (returns) 処理内容と動作モードからなる構造体              (/returns)
    ''' --------------------------------------------------------------------
    Private Function GetTransact(ByVal byt As Byte) As Transact
        ' 戻り値を一時保持するためのオブジェクトををインスタンス
        Dim tact As New Transact With
                {.strTransact = "", .enmMode = Mode.Normal}
        ' Byte変数に従って分岐し、情報をセットする
        With tact
            Select Case byt
                Case &H1
                    .strTransact = "運賃支払(改札出場)"
                Case &H2
                    .strTransact = "チャージ"
                Case &H3
                    .strTransact = "券購(磁気券購入)"
                Case &H4
                    .strTransact = "精算"
                Case &H5
                    .strTransact = "精算 (入場精算)"
                Case &H6
                    .strTransact = "窓出 (改札窓口処理)"
                Case &H7
                    .strTransact = "新規 (新規発行)"
                Case &H8
                    .strTransact = "控除 (窓口控除)"
                Case &HD
                    .strTransact = "バス (PiTaPa系)"
                    .enmMode = Mode.Bus
                Case &HF
                    .strTransact = "バス (IruCa系)"
                    .enmMode = Mode.Bus
                Case &H11
                    .strTransact = "再発 (再発行処理)"
                Case &H13
                    .strTransact = "支払 (新幹線利用)"
                Case &H14
                    .strTransact = "入A (入場時オートチャージ)"
                Case &H15
                    .strTransact = "出A (出場時オートチャージ)"
                Case &H1F
                    .strTransact = "入金 (バスチャージ)"
                    .enmMode = Mode.Bus
                Case &H23
                    .strTransact = "券購 (バス路面電車企画券購入)"
                    .enmMode = Mode.Bus
                Case &H46
                    .strTransact = "物販"
                    .enmMode = Mode.ProductSales
                Case &H48
                    .strTransact = "特典 (特典チャージ)"
                Case &H49
                    .strTransact = "入金 (レジ入金)"
                    .enmMode = Mode.ProductSales
                Case &H4A
                    .strTransact = "物販取消"
                    .enmMode = Mode.ProductSales
                Case &H4B
                    .strTransact = "入物 (入場物販)"
                    .enmMode = Mode.ProductSales
                Case &HC6
                    .strTransact = "物現 (現金併用物販)"
                    .enmMode = Mode.ProductSales
                Case &HCB
                    .strTransact = "入物 (入場現金併用物販)"
                    .enmMode = Mode.ProductSales
                Case &H84
                    .strTransact = " 精算 (他社精算)"
                Case &H85
                    .strTransact = " 精算 (他社入場精算)"
                Case Else
            End Select
        End With
        Return tact
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary) フォームをロードしたときの処理(メインルーチン)(/summary)
    ''' --------------------------------------------------------------------
    Private Sub FrmMain_Load(
            sender As Object,
            e As EventArgs) _
            Handles Me.Load

        ' --- リソースマネージャコンテキストを確立する ---
        Dim hContext As IntPtr  ' コンテキストを識別するハンドル
        Dim URet As UInteger = SCardEstablishContext(
                SCARD_SCOPE_USER, IntPtr.Zero, IntPtr.Zero, hContext)
        If URet <> SCARD_S_SUCCESS Then GoTo PostHandler

        ' --- カードリーダのリストを取得する ---
        ' バッファ長を取得する
        Dim pcchReaders As UInteger ' mszReadersバッファ長
        URet = SCardListReaders(hContext, Nothing, Nothing, pcchReaders)
        If URet <> SCARD_S_SUCCESS Then GoTo PostHandler
        ' Byteの配列でバッファを用意し、リストを取得する
        Dim mszReaders As Byte() =
                New Byte(Convert.ToInt32(pcchReaders) * 2 - 1) {}
        URet = SCardListReaders(hContext, Nothing, mszReaders, pcchReaders)
        If URet <> SCARD_S_SUCCESS Then GoTo PostHandler
        ' Byte配列を文字に変換して1つ目のリーダ名を取得する
        Dim szReader As String =
                System.Text.Encoding.ASCII.GetString(mszReaders).
                Split(vbNullChar.ToCharArray)(0)

        ' --- リーダにカードがかざされるのを待つ ---
        Dim dwTimeout As Integer = System.Threading.Timeout.Infinite
        Dim rgReaderStates(0) As SCARD_READERSTATE  ' 監視対象リーダ用
        rgReaderStates(0).szReader = szReader       ' 監視対象のリーダ名
        ' すぐに初回のレポートを受信する設定
        rgReaderStates(0).dwCurrentState = SCARD_STATE_UNAWARE
        ' リーダにカードがかざされるまで待機
        Do
            ' 監視する
            URet = SCardGetStatusChange(hContext, dwTimeout,
                    rgReaderStates(0), rgReaderStates.Count)
            If URet <> SCARD_S_SUCCESS Then GoTo PostHandler
            ' カードが確認されたらループを抜ける
            If (rgReaderStates(0).dwEventState And
                    SCARD_STATE_PRESENT) <> 0 Then Exit Do
        Loop

        ' --- アプリケーションとカードの接続を確立する ---
        Dim hCard As IntPtr
        Dim pdwActiveProtocol As IntPtr = IntPtr.Zero
        URet = SCardConnect(hContext, szReader,
                SCARD_SHARE_SHARED, SCARD_PROTOCOL_T0 Or SCARD_PROTOCOL_T1,
                hCard, pdwActiveProtocol)
        If URet <> SCARD_S_SUCCESS Then GoTo PostHandler

        ' --- サービスリクエストを送信しデータバックを受信する ---
        ' 命令プロトコルヘッダへのポインタを作成する
        Dim pioSendPci As IntPtr    ' ヘッダへのポインタ
        ' winscard.dllのハンドラを取得する
        Dim hModule As IntPtr = LoadLibrary("winscard.dll")
        ' プロトコルに応じて分岐
        If pdwActiveProtocol = CType(SCARD_PROTOCOL_T0, IntPtr) Then
            ' 調歩式半二重キャラクタ伝送プロトコルの場合
            pioSendPci = GetProcAddress(hModule, "g_rgSCardT0Pci")
        ElseIf pdwActiveProtocol = CType(SCARD_PROTOCOL_T1, IntPtr) Then
            ' 調歩式半二重ブロック伝送プロトコルの場合
            pioSendPci = GetProcAddress(hModule, "g_rgSCardT1Pci")
        End If
        ' DLLモジュールを解放する
        FreeLibrary(hModule)

        ' カードUIDの取得コマンド
        Dim pbSendBuffer As Byte() = New Byte() {&HFF, &HCA, &H0, &H0}
        ' 受信プロトコルヘッダのポインタ
        Dim pioRecvRequest As SCARD_IO_REQUEST = Nothing
        ' 返信データ用バッファ
        Dim pbrecvBuffer As Byte() = New Byte(511) {}
        ' 返信データ用バッファサイズ
        Dim pcbRecvLength As Integer = pbrecvBuffer.Length
        ' サービスリクエストを送信しデータバックを受信する
        URet = SCardTransmit(
                hCard, pioSendPci, pbSendBuffer, pbSendBuffer.Length,
                pioRecvRequest, pbrecvBuffer, pcbRecvLength)
        If URet <> SCARD_S_SUCCESS Then GoTo PostHandler
        ' 結果出力
        Console.WriteLine(BitConverter.ToString(
                pbrecvBuffer, 0, pcbRecvLength - 2))

        ' --- ここからSuicaからの読み出し ---
        ' 読み出しファイルの設定
        pbSendBuffer = New Byte() {&HFF, &HA4, &H0, &H1, &H2, &HF, &H9}
        ' 受信プロトコルヘッダのポインタ
        pioRecvRequest = Nothing
        ' 返信データ用バッファ
        pbrecvBuffer = New Byte(511) {}
        ' 返信データ用バッファサイズ
        pcbRecvLength = pbrecvBuffer.Length
        ' サービスリクエストを送信しデータバックを受信する
        URet = SCardTransmit(
                hCard, pioSendPci, pbSendBuffer, pbSendBuffer.Length,
                pioRecvRequest, pbrecvBuffer, pcbRecvLength)
        If URet <> SCARD_S_SUCCESS Then GoTo PostHandler
        ' 履歴を確認できるのは20件まで
        For i = 0 To 19
            ' 履歴の取得コマンド
            pbSendBuffer = New Byte() {&HFF, &HB0, &H0, &H0, &H0}
            pbSendBuffer(3) = CByte(i)
            ' 受信プロトコルヘッダのポインタ
            pioRecvRequest = Nothing
            ' 返信データ用バッファ
            pbrecvBuffer = New Byte(511) {}
            ' 返信データ用バッファサイズ
            pcbRecvLength = pbrecvBuffer.Length
            ' サービスリクエストを送信しデータバックを受信する
            URet = SCardTransmit(
                    hCard, pioSendPci, pbSendBuffer, pbSendBuffer.Length,
                    pioRecvRequest, pbrecvBuffer, pcbRecvLength)
            If URet <> SCARD_S_SUCCESS Then GoTo PostHandler
            ' 結果出力
            If pcbRecvLength = 18 Then
                AnalyzeRecords(pbrecvBuffer, pcbRecvLength)
            End If
        Next i
        ' --- Suicaからの読み出しここまで ---

PostHandler:
        ' --- 接続を終了する ---
        If hCard <> CType(&H0, IntPtr) Then _
                SCardDisconnect(hCard, SCARD_LEAVE_CARD)
        If hContext <> CType(&H0, IntPtr) Then SCardReleaseContext(hContext)

        ' エラーの場合の処理
        If URet <> SCARD_S_SUCCESS Then
            Throw New Exception($"{URet}:{GetErrMsg(URet)}")
        End If
    End Sub
End Class

次に、モジュール(SCard.vb)を追加し、winscard.dllを呼び出すための関数群を貼り付けます。

Imports System.Runtime.InteropServices

Module SCard
    ' ───────────────────────────────────
    '  定数の宣言       
    ' ───────────────────────────────────
    ''' --------------------------------------------------------------------
    ''' (summary) 定数                                            (/summary)
    ''' --------------------------------------------------------------------
    Public Const SCARD_S_SUCCESS As Integer = 0
    Public Const SCARD_F_INTERNAL_ERROR As Integer = &H80100001
    Public Const SCARD_E_CANCELLED As Integer = &H80100002
    Public Const SCARD_E_INVALID_HANDLE As Integer = &H80100003
    Public Const SCARD_E_INVALID_PARAMETER As Integer = &H80100004
    Public Const SCARD_E_INVALID_TARGET As Integer = &H80100005
    Public Const SCARD_E_NO_MEMORY As Integer = &H80100006
    Public Const SCARD_F_WAITED_TOO_LONG As Integer = &H80100007
    Public Const SCARD_E_INSUFFICIENT_BUFFER As Integer = &H80100008
    Public Const SCARD_E_UNKNOWN_READER As Integer = &H80100009
    Public Const SCARD_E_TIMEOUT As Integer = &H8010000A
    Public Const SCARD_E_SHARING_VIOLATION As Integer = &H8010000B
    Public Const SCARD_E_NO_SMARTCARD As Integer = &H8010000C
    Public Const SCARD_E_UNKNOWN_CARD As Integer = &H8010000D
    Public Const SCARD_E_CANT_DISPOSE As Integer = &H8010000E
    Public Const SCARD_E_PROTO_MISMATCH As Integer = &H8010000F
    Public Const SCARD_E_NOT_READY As Integer = &H80100010
    Public Const SCARD_E_INVALID_VALUE As Integer = &H80100011
    Public Const SCARD_E_SYSTEM_CANCELLED As Integer = &H80100012
    Public Const SCARD_E_COMM_ERROR As Integer = &H80100013
    Public Const SCARD_F_UNKNOWN_ERROR As Integer = &H80100014
    Public Const SCARD_E_INVALID_ATR As Integer = &H80100015
    Public Const SCARD_E_NOT_TRANSACTED As Integer = &H80100016
    Public Const SCARD_E_READER_UNAVAILABLE As Integer = &H80100017
    Public Const SCARD_P_SHUTDOWN As Integer = &H80100018
    Public Const SCARD_E_PCI_TOO_SMALL As Integer = &H80100019
    Public Const SCARD_E_READER_UNSUPPORTED As Integer = &H8010001A
    Public Const SCARD_E_DUPLICATE_READER As Integer = &H8010001B
    Public Const SCARD_E_CARD_UNSUPPORTED As Integer = &H8010001C
    Public Const SCARD_E_NO_SERVICE As Integer = &H8010001D
    Public Const SCARD_E_SERVICE_STOPPED As Integer = &H8010001E
    Public Const SCARD_E_UNEXPECTED As Integer = &H8010001F
    Public Const SCARD_E_ICC_INSTALLATION As Integer = &H80100020
    Public Const SCARD_E_ICC_CREATEORDER As Integer = &H80100021
    Public Const SCARD_E_UNSUPPORTED_FEATURE As Integer = &H80100022
    Public Const SCARD_E_DIR_NOT_FOUND As Integer = &H80100023
    Public Const SCARD_E_FILE_NOT_FOUND As Integer = &H80100024
    Public Const SCARD_E_NO_DIR As Integer = &H80100025
    Public Const SCARD_E_NO_FILE As Integer = &H80100026
    Public Const SCARD_E_NO_ACCESS As Integer = &H80100027
    Public Const SCARD_E_WRITE_TOO_MANY As Integer = &H80100028
    Public Const SCARD_E_BAD_SEEK As Integer = &H80100029
    Public Const SCARD_E_INVALID_CHV As Integer = &H8010002A
    Public Const SCARD_E_UNKNOWN_RES_MNG As Integer = &H8010002B
    Public Const SCARD_E_NO_SUCH_CERTIFICATE As Integer = &H8010002C
    Public Const SCARD_E_CERTIFICATE_UNAVAILABLE As Integer = &H8010002D
    Public Const SCARD_E_NO_READERS_AVAILABLE As Integer = &H8010002E
    Public Const SCARD_E_COMM_DATA_LOST As Integer = &H8010002F
    Public Const SCARD_E_NO_KEY_CONTAINER As Integer = &H80100030
    Public Const SCARD_E_SERVER_TOO_BUSY As Integer = &H80100031
    Public Const SCARD_E_PIN_CACHE_EXPIRED As Integer = &H80100032
    Public Const SCARD_E_NO_PIN_CACHE As Integer = &H80100033
    Public Const SCARD_E_READ_ONLY_CARD As Integer = &H80100034
    Public Const SCARD_W_UNSUPPORTED_CARD As Integer = &H80100065
    Public Const SCARD_W_UNRESPONSIVE_CARD As Integer = &H80100066
    Public Const SCARD_W_UNPOWERED_CARD As Integer = &H80100067
    Public Const SCARD_W_RESET_CARD As Integer = &H80100068
    Public Const SCARD_W_REMOVED_CARD As Integer = &H80100069
    Public Const SCARD_W_SECURITY_VIOLATION As Integer = &H8010006A
    Public Const SCARD_W_WRONG_CHV As Integer = &H8010006B
    Public Const SCARD_W_CHV_BLOCKED As Integer = &H8010006C
    Public Const SCARD_W_EOF As Integer = &H8010006D
    Public Const SCARD_W_CANCELLED_BY_USER As Integer = &H8010006E
    Public Const SCARD_W_CARD_NOT_AUTHENTICATED As Integer = &H8010006F
    Public Const SCARD_W_CACHE_ITEM_NOT_FOUND As Integer = &H80100070
    Public Const SCARD_W_CACHE_ITEM_STALE As Integer = &H80100071
    Public Const SCARD_W_CACHE_ITEM_TOO_BIG As Integer = &H80100072

    Public Const SCARD_PROTOCOL_T0 As Integer = 1
    Public Const SCARD_PROTOCOL_T1 As Integer = 2
    Public Const SCARD_PROTOCOL_RAW As Integer = 4
    Public Const SCARD_SCOPE_USER As UInteger = 0
    Public Const SCARD_SCOPE_TERMINAL As UInteger = 1
    Public Const SCARD_SCOPE_SYSTEM As UInteger = 2
    Public Const SCARD_STATE_UNAWARE As Integer = &H0
    Public Const SCARD_STATE_IGNORE As Integer = &H1
    Public Const SCARD_STATE_CHANGED As Integer = &H2
    Public Const SCARD_STATE_UNKNOWN As Integer = &H4
    Public Const SCARD_STATE_UNAVAILABLE As Integer = &H8
    Public Const SCARD_STATE_EMPTY As Integer = &H10
    Public Const SCARD_STATE_PRESENT As Integer = &H20
    Public Const SCARD_STATE_ATRMATCH As Integer = &H40
    Public Const SCARD_STATE_EXCLUSIVE As Integer = &H80
    Public Const SCARD_STATE_INUSE As Integer = &H100
    Public Const SCARD_STATE_MUTE As Integer = &H200
    Public Const SCARD_STATE_UNPOWERED As Integer = &H400
    Public Const SCARD_SHARE_EXCLUSIVE As Integer = &H1
    Public Const SCARD_SHARE_SHARED As Integer = &H2
    Public Const SCARD_SHARE_DIRECT As Integer = &H3
    Public Const SCARD_LEAVE_CARD As Integer = 0
    Public Const SCARD_RESET_CARD As Integer = 1
    Public Const SCARD_UNPOWER_CARD As Integer = 2
    Public Const SCARD_EJECT_CARD As Integer = 3

    ' ───────────────────────────────────
    '  構造体の宣言       
    ' ───────────────────────────────────
    ''' --------------------------------------------------------------------
    ''' (summary) スマートカードトラッキング用構造体              (/summary)
    ''' --------------------------------------------------------------------
    Public Structure SCARD_READERSTATE
        Friend szReader As String           ' モニタしているリーダへのポインタ
        Friend pvUserData As IntPtr         ' 不使用
        Friend dwCurrentState As UInt32     ' アプリケーションから見た状態
        Friend dwEventState As UInt32       ' リソースマネージャから見た状態
        Friend cbAtr As UInt32              ' ATRのバイト数
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=36)>' 配列サイズの固定
        Friend rgbAtr() As Byte             ' カードのATR
    End Structure

    ' ───────────────────────────────────
    '  クラスの宣言       
    ' ───────────────────────────────────
    ''' --------------------------------------------------------------------
    ''' (summary) プロトコル制御情報クラス                        (/summary)
    ''' --------------------------------------------------------------------
    Public Class SCARD_IO_REQUEST
        Friend dwProtocol As UInteger   ' 使用中のプロトコル
        Friend cbPciLength As Integer   ' クラスのサイズとPCI固有の情報
    End Class

    ' ───────────────────────────────────
    '  変数の宣言       
    ' ───────────────────────────────────
    ' ───────────────────────────────────
    '  API関数の宣言       
    ' ───────────────────────────────────
    ''' --------------------------------------------------------------------
    ''' (summary) リソースマネージャコンテキストを確立する        (/summary)
    ''' (param name="dwScope")     コンテキストのスコープ           (/param)
    ''' (param name="pvReserved1") 予約変数。NULLにする             (/param)
    ''' (param name="pvReserved2") 予約変数。NULLにする             (/param)
    ''' (param name="phContext")   コンテキストへのハンドル         (/param)
    ''' (returns) エラーコード                                    (/returns)
    ''' --------------------------------------------------------------------
    <DllImport("winscard.dll")>
    Public Function SCardEstablishContext(
            ByVal dwScope As UInteger,
            ByVal pvReserved1 As IntPtr,
            ByVal pvReserved2 As IntPtr,
            ByRef phContext As IntPtr) _
            As UInteger
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary) リーダーグループ中のリーダリストを提供する      (/summary)
    ''' (param name="hContext")    コンテキストを識別するハンドル   (/param)
    ''' (param name="mszGroups")   リーダーグループの名前           (/param)
    ''' (param name="mszReaders")  カードリーダー一覧               (/param)
    ''' (param name="pcchReaders") mszReadersバッファ長             (/param)
    ''' (returns) エラーコード                                    (/returns)
    ''' --------------------------------------------------------------------
    <DllImport("winscard.dll")>
    Public Function SCardListReaders(
            ByVal hContext As IntPtr,
            ByVal mszGroups As Byte(),
            ByVal mszReaders As Byte(),
            ByRef pcchReaders As UInt32) _
            As UInteger
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary) リーダが特定の状態になるまで実行を待機する      (/summary)
    ''' (param name="hContext")       コンテキストを識別するハンドル(/param)
    ''' (param name="dwTimeout")      待ち時間[ms]。INFINITEなら∞  (/param)
    ''' (param name="rgReaderStates") 監視するリーダ構造体の配列    (/param)
    ''' (param name="cReaders")       rgReaderStatesの配列サイズ    (/param)
    ''' (returns) エラーコード                                    (/returns)
    ''' --------------------------------------------------------------------
    <DllImport("winscard.dll")>
    Public Function SCardGetStatusChange(
            ByVal hContext As IntPtr,
            ByVal dwTimeout As Integer,
            ByRef rgReaderStates As SCARD_READERSTATE,
            ByVal cReaders As Integer) _
            As UInteger
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary> アプリケーションとカードの接続を確立する        (/summary)
    ''' (param name="hContext")             コンテキスト識別ハンドル(/param)
    ''' (param name="szReader")             リーダ名                (/param)
    ''' (param name="dwShareMode")          他アプリ排除フラグ      (/param)
    ''' (param name="dwPreferredProtocols") 接続プロトコル          (/param)
    ''' (param name="phCard")               カードへのハンドル      (/param)
    ''' (param name="pdwActiveProtocol")    確立されたプロトコル    (/param)
    ''' (returns) エラーコード                                    (/returns)
    ''' --------------------------------------------------------------------
    <DllImport("winscard.dll")>
    Public Function SCardConnect(
            ByVal hContext As IntPtr,
            ByVal szReader As String,
            ByVal dwShareMode As UInteger,
            ByVal dwPreferredProtocols As UInteger,
            ByRef phCard As IntPtr,
            ByRef pdwActiveProtocol As IntPtr) _
            As UInteger
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary) リーダの直接制御                                (/summary)
    ''' (param name="hCard">SCardConnectから返される参照値          (/param)
    ''' (param name="dwControlCode)    操作の制御コード             (/param)
    ''' (param name="lpInBuffer")      データバッファへのポインタ   (/param)
    ''' (param name="cbInBufferSize")  lpInBufferのサイズ           (/param)
    ''' (param name="lpOutBuffer")     出力バッファへのポインタ     (/param)
    ''' (param name="cbOutBufferSize") lpOutBufferのサイズ          (/param)
    ''' (param name="lpBytesReturned") lpOutBufferに格納されたサイズ(/param)
    ''' (returns> エラーコード                                    (/returns)
    ''' --------------------------------------------------------------------
    <DllImport("winscard.dll")>
    Public Function SCardControl(
            ByVal hCard As IntPtr,
            ByVal dwControlCode As Integer,
            ByVal lpInBuffer As Byte(),
            ByVal cbInBufferSize As Integer,
            ByVal lpOutBuffer As Byte(),
            ByVal cbOutBufferSize As Integer,
            ByRef lpBytesReturned As Integer) _
            As UInteger
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary> カードの状態                                    (/summary)
    ''' (param name="hCard")          SCardConnectから返される参照値(/param)
    ''' (param name="mszReaderNames") リーダから返された表示名      (/param)
    ''' (param name="pcchReaderLen")  szReaderName bufferのサイズ   (/param)
    ''' (param name="pdwState")       リーダ内のカードの状態        (/param)
    ''' (param name="pdwProtocol")    現在プロトコル                (/param)
    ''' (param name="pbAtr")          ATR文字列へのポインタ         (/param)
    ''' (param name="pcbAtrLen")      用意したサイズと受信したサイズ(/param)
    ''' (returns) エラーコード                                    (/returns)
    ''' --------------------------------------------------------------------
    <DllImport("winscard.dll")>
    Public Function SCardStatus(
            ByVal hCard As IntPtr,
            ByVal mszReaderNames As String,
            ByVal pcchReaderLen As Integer,
            ByVal pdwState As Integer,
            ByVal pdwProtocol As Integer,
            ByVal pbAtr As Byte,
            ByVal pcbAtrLen As Integer) _
            As UInteger
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary> サービスリクエストを送信しデータバックを受信する(/summary)
    ''' (param name="hCard")          SCardConnectから返される参照値(/param)
    ''' (param name="pioSendPci)     命令プロトコルヘッダのポインタ(/param)
    ''' (param name="pbSendBuffer")   送信データへのポインタ        (/param)
    ''' (param name="cbSendLength")   pbSendBufferパラメーターの長さ(/param)
    ''' (param name="pioRecvPci")     受信プロトコルヘッダのポインタ(/param)
    ''' (param name="pbRecvBuffer")   返信データへのポインタ        (/param)
    ''' (param name="pcbRecvvLength") pbRecvBufferパラメーターの長さ(/param)
    ''' (returns) エラーコード                                    (/returns)
    ''' --------------------------------------------------------------------
    <DllImport("winscard.dll")>
    Public Function SCardTransmit(
            ByVal hCard As IntPtr,
            ByVal pioSendPci As IntPtr,
            ByVal pbSendBuffer As Byte(),
            ByVal cbSendLength As Integer,
            ByVal pioRecvPci As SCARD_IO_REQUEST,
            ByVal pbRecvBuffer As Byte(),
            ByRef pcbRecvvLength As Integer) _
            As UInteger
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary) 接続を終了する                                  (/summary)
    ''' (param name="hCard")         SCardConnectから返される参照値 (/param)
    ''' (param name="dwDisposition)  実行時のカードへのアクション   (/param)
    ''' (returns) エラーコード                                    (/returns)
    ''' --------------------------------------------------------------------
    <DllImport("winscard.dll")>
    Public Function SCardDisconnect(
            ByVal hCard As IntPtr,
            ByVal dwDisposition As Integer) _
            As UInteger
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary)コンテクストを閉じ、リソースを解放する           (/summary)
    ''' (param name="hContext") コンテキスト識別ハンドル            (/param)
    ''' (returns) エラーコード                                    (/returns)
    ''' --------------------------------------------------------------------
    <DllImport("winscard.dll")>
    Public Function SCardReleaseContext(
            ByVal hContext As IntPtr) _
            As UInteger
    End Function

    ' ───────────────────────────────────

    ''' --------------------------------------------------------------------
    ''' (summary) DLLモジュールを解放する                         (/summary)
    ''' (param name="handle") ロードされたライブラリへのハンドル    (/param)
    ''' --------------------------------------------------------------------
    <DllImport("kernel32.dll")>
    Public Sub FreeLibrary(ByVal handle As IntPtr)
    End Sub

    ''' --------------------------------------------------------------------
    ''' (summary) DLLからの関数や変数へのアドレスを取得する       (/summary)
    ''' (param name="hModule)    DLLモジュールのハンドル           (/param)
    ''' (param name="lpProcName") 関数または変数名、または関数の序数(/param)
    ''' (returns) 関数または変数のアドレス                        (/returns)
    ''' --------------------------------------------------------------------
    <DllImport("kernel32.dll")>
    Public Function GetProcAddress(
            ByVal hModule As IntPtr,
            ByVal lpProcName As String) _
            As IntPtr
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary) 指定したモジュールをアドレス空間にロードする    (/summary)
    ''' (param name="lpLibFileName"> モジュール名                   (/param)
    ''' (returns) 成功したらモジュールのハンドル、失敗したらNULL  (/returns)
    ''' --------------------------------------------------------------------
    <DllImport("kernel32.dll")>
    Public Function LoadLibrary(
            ByVal lpLibFileName As String) _
            As IntPtr
    End Function

    ' ───────────────────────────────────
    '  本体       
    ' ───────────────────────────────────
    ''' --------------------------------------------------------------------
    ''' (summary) エラーコードからエラーメッセージを取得する      (/summary)
    ''' (param name="uintErr"> エラーコード                         (/param)
    ''' (returns) エラーメッセージ                                (/returns)
    ''' --------------------------------------------------------------------
    Public Function GetErrMsg(ByVal uintErr As UInteger) As String
        Select Case Uint2Int(uintErr)
            Case SCARD_S_SUCCESS
                Return "SUCCESS"
            Case SCARD_F_INTERNAL_ERROR
                Return "INTERNAL_ERROR"
            Case SCARD_E_CANCELLED
                Return "CANCELLED"
            Case SCARD_E_INVALID_HANDLE
                Return "INVALID_HANDLE"
            Case SCARD_E_INVALID_PARAMETER
                Return "INVALID_PARAMETER"
            Case SCARD_E_INVALID_TARGET
                Return "INVALID_TARGET"
            Case SCARD_E_NO_MEMORY
                Return "NO_MEMORY"
            Case SCARD_F_WAITED_TOO_LONG
                Return "WAITED_TOO_LONG"
            Case SCARD_E_INSUFFICIENT_BUFFER
                Return "INSUFFICIENT_BUFFER"
            Case SCARD_E_UNKNOWN_READER
                Return "UNKNOWN_READER"
            Case SCARD_E_TIMEOUT
                Return "TIMEOUT"
            Case SCARD_E_SHARING_VIOLATION
                Return "SHARING_VIOLATION"
            Case SCARD_E_NO_SMARTCARD
                Return "NO_SMARTCARD"
            Case SCARD_E_UNKNOWN_CARD
                Return "UNKNOWN_CARD"
            Case SCARD_E_CANT_DISPOSE
                Return "CANT_DISPOSE"
            Case SCARD_E_PROTO_MISMATCH
                Return "PROTO_MISMATCH"
            Case SCARD_E_NOT_READY
                Return "NOT_READY"
            Case SCARD_E_INVALID_VALUE
                Return "INVALID_VALUE"
            Case SCARD_E_SYSTEM_CANCELLED
                Return "SYSTEM_CANCELLED"
            Case SCARD_E_COMM_ERROR
                Return "COMM_ERROR"
            Case SCARD_F_UNKNOWN_ERROR
                Return "UNKNOWN_ERROR"
            Case SCARD_E_INVALID_ATR
                Return "INVALID_ATR"
            Case SCARD_E_NOT_TRANSACTED
                Return "NOT_TRANSACTED"
            Case SCARD_E_READER_UNAVAILABLE
                Return "READER_UNAVAILABLE"
            Case SCARD_P_SHUTDOWN
                Return "SHUTDOWN"
            Case SCARD_E_PCI_TOO_SMALL
                Return "PCI_TOO_SMALL"
            Case SCARD_E_READER_UNSUPPORTED
                Return "READER_UNSUPPORTED"
            Case SCARD_E_DUPLICATE_READER
                Return "DUPLICATE_READER"
            Case SCARD_E_CARD_UNSUPPORTED
                Return "CARD_UNSUPPORTED"
            Case SCARD_E_NO_SERVICE
                Return "NO_SERVICE"
            Case SCARD_E_SERVICE_STOPPED
                Return "SERVICE_STOPPED"
            Case SCARD_E_UNEXPECTED
                Return "UNEXPECTED"
            Case SCARD_E_ICC_INSTALLATION
                Return "ICC_INSTALLATION"
            Case SCARD_E_ICC_CREATEORDER
                Return "ICC_CREATEORDER"
            Case SCARD_E_UNSUPPORTED_FEATURE
                Return "UNSUPPORTED_FEATURE"
            Case SCARD_E_DIR_NOT_FOUND
                Return "DIR_NOT_FOUND"
            Case SCARD_E_FILE_NOT_FOUND
                Return "FILE_NOT_FOUND"
            Case SCARD_E_NO_DIR
                Return "NO_DIR"
            Case SCARD_E_NO_FILE
                Return "NO_FILE"
            Case SCARD_E_NO_ACCESS
                Return "NO_ACCESS"
            Case SCARD_E_WRITE_TOO_MANY
                Return "WRITE_TOO_MANY"
            Case SCARD_E_BAD_SEEK
                Return "BAD_SEEK"
            Case SCARD_E_INVALID_CHV
                Return "INVALID_CHV"
            Case SCARD_E_UNKNOWN_RES_MNG
                Return "UNKNOWN_RES_MNG"
            Case SCARD_E_NO_SUCH_CERTIFICATE
                Return "NO_SUCH_CERTIFICATE"
            Case SCARD_E_CERTIFICATE_UNAVAILABLE
                Return "CERTIFICATE_UNAVAILABLE"
            Case SCARD_E_NO_READERS_AVAILABLE
                Return "NO_READERS_AVAILABLE"
            Case SCARD_E_COMM_DATA_LOST
                Return "COMM_DATA_LOST"
            Case SCARD_E_NO_KEY_CONTAINER
                Return "NO_KEY_CONTAINER"
            Case SCARD_E_SERVER_TOO_BUSY
                Return "SERVER_TOO_BUSY"
            Case SCARD_E_PIN_CACHE_EXPIRED
                Return "PIN_CACHE_EXPIRED"
            Case SCARD_E_NO_PIN_CACHE
                Return "NO_PIN_CACHE"
            Case SCARD_E_READ_ONLY_CARD
                Return "READ_ONLY_CARD"
            Case SCARD_W_UNSUPPORTED_CARD
                Return "UNSUPPORTED_CARD"
            Case SCARD_W_UNRESPONSIVE_CARD
                Return "UNRESPONSIVE_CARD"
            Case SCARD_W_UNPOWERED_CARD
                Return "UNPOWERED_CARD"
            Case SCARD_W_RESET_CARD
                Return "RESET_CARD"
            Case SCARD_W_REMOVED_CARD
                Return "REMOVED_CARD"
            Case SCARD_W_SECURITY_VIOLATION
                Return "SECURITY_VIOLATION"
            Case SCARD_W_WRONG_CHV
                Return "WRONG_CHV"
            Case SCARD_W_CHV_BLOCKED
                Return "CHV_BLOCKED"
            Case SCARD_W_EOF
                Return "EOF"
            Case SCARD_W_CANCELLED_BY_USER
                Return "CANCELLED_BY_USER"
            Case SCARD_W_CARD_NOT_AUTHENTICATED
                Return "CARD_NOT_AUTHENTICATED"
            Case SCARD_W_CACHE_ITEM_NOT_FOUND
                Return "CACHE_ITEM_NOT_FOUND"
            Case SCARD_W_CACHE_ITEM_STALE
                Return "CACHE_ITEM_STALE"
            Case SCARD_W_CACHE_ITEM_TOO_BIG
                Return "CACHE_ITEM_TOO_BIG"
            Case Else
                Return "UNKENOWN"
        End Select
    End Function

    ''' --------------------------------------------------------------------
    ''' (summary) UIntegerをIntegerに変換する                     (/summary)
    ''' (param name="uint"> UInteger                                (/param)
    ''' (returns) Integer                                         (/returns)
    ''' --------------------------------------------------------------------
    Private Function Uint2Int(ByVal uint As UInteger) As Integer
        Dim lng As Long = CLng(uint - 2 ^ 32)
        Return CInt(lng)
    End Function
End Module

実行する前に、FrmMain.vbのGetStationNameにある

odbConnStrBldr.Dsn = “PostgreSQL30

のところを先ほど調べたデータソース名に変更します。

また、このままだと、FrmMain.vbのGetStationNameにおいて、OdbcConnectionをOpenするための「odbConn.Open()」で、エラーが発生する可能性があります。エラーメッセージは、「ERROR [IM014] [Microsoft][ODBC Driver Manager] 指定された DSN には、ドライバーとアプリケーションとのアーキテクチャの不一致が含まれています」です。これは、64ビットのODBCデータソースと32ビットのCPUプラットフォームが合っていないことが原因です。対策として、「Any CPU」の右側の「▼」から、「構成マネージャー…」を選択し、プラットフォーム欄で「<新規作成…>」新しいプラットフォームから「x64」を選びます。

Suica履歴読み出しソフトを実行する

SONY RC-S380については、あらかじめPCにドライバを入れて使えるようにしておいてください。

本ソフトを実行し、Suicaをリーダにかざすと出力ウィンドウに読み出し履歴が表示されます。
読み出し例を以下に示します。

00-24-b4 : 4,395 : 2021/04/13 : 11:57 : 物販端末 : 物販
00-24-b3 : 3,173 : 2021/04/12 : 11:56 : 自販機 : 入金 (レジ入金)
00-24-b2 : 2,173 : 2021/04/11 : 東日本旅客鉄道, 山手, 目白 : 東日本旅客鉄道, 中央本, 東中野 : 改札機 : 運賃支払(改札出場)

ソフトの改造について

以下にソフトの改造案を挙げてみます。

読み出した各レコードの15バイト目(リージョン)をそのまま地区コードとして使っています。この使い方は、誤っている可能性があるので、必要に応じて直してください。

本ソフトは、フォームをロードしたときに1回だけ実行するようにしています。本来は、連続稼働させておいて、Suicaをリーダにかざすたびに実行させるべきだと思います。

Suicaの中のレコードには、利用額の情報が無く、残金データしかありません。よって、読み出す順番を逆にして、古いレコードから新しいレコードの順に読み出せば、利用額を算出するのが楽だと思います。本ソフトでは、利用額を計算していません

今回は、駅名をPostgreSQLから取り出しました。同様の手順でPostgreSQLにデータを登録することもできます。さらに、本ソフトではIDmも取得できるので、カードを区別することができます。よって、まめにSuicaをリーダにかざすだけで、家族全員の簡易な旅行記録や小遣帳をデータベース上に自動作成することができるはずです。

まとめ

Suicaの履歴を読み出してみました。

「変な操作をして、カードがロックするようなことはないだろうか」と心配しながらテストを始めましたが、あっさりとレコードを取り出すことができました。

1レコードは16バイトであり、その小さい容量内にデータを格納する工夫が理解できて興味深かったです。

なお、本記事の執筆にあたり、こちらを参考にさせていただきました。

コメント

タイトルとURLをコピーしました