白執事の徒然なる日々


主にコンピュータ関係の記事を書いています。

プロフィール

白執事☆

こんにちは、白執事です。
PC関係の記事を書いていきますので
よろしくお願いします。

VB.NET で USBデバイス を検出する!

このページの目標

(1) ソフトを起動して…



(2) パソコンに PaSoRi を接続すると…



(3) PaSoRi のデバイス情報が表示されることを目標とします!



プログラム作成に必要な物

(1) Visual Basic 2005, 2008, 2010, 2012 のいずれかで Express Edition がインストールされていれば十分です。
     プロジェクトを新規作成する時に、ターゲットとなる .NET Framework のバージョンは 2.0 でかまいません。

(2) FeliCaポートソフトウェア がインストールされていること。
     PaSoRi があれば、付属のCDにドライバが入ってるはずなので、そこからインストールして下さい。
     手元にCDがない場合は こちら からダウンロードしてインストールして下さい。

(3) PaSoRi
     対応機種: RC-S380 / S370 / S330 / S320


VB.NET で USBデバイス(PaSoRi) を検出するサンプル

VB 2005 (.NET Framework 2.0) 以降を対象としています。

※ライセンスは特に設けておりませんので、使いたい方がいれば自由に使って頂いてかまいません。
 ただし、このサンプルを使用した事でいかなる損害が発生しても責任は負いかねますので、自己責任でお願い致します。

[ Visual Basic .NET ]
まず、プロジェクトを新規作成して、プロパティ画面で参照を追加します。


System.Management を追加して下さい。 ※WMI (Windows Management Instrumentation) を使うために必要です。


Form1TextBox を貼り付けて、下記プロパティを設定して下さい。



[ Form1.vb ]
'************************************************************************
' PaSoRiが抜き差しされたタイミングで詳細情報を取得します。
'------------------------------------------------------------------------
' (1) WndProc() でUSBデバイスの抜き差しを検知します。
'     --> Windowsメッセージが WM_DEVICECHANGE の場合に処理
' (2) 別スレッドでPaSoRiの情報を取得します。
'     --> WMI(Windows Management Instrumentation)を使用
'         WMIの情報取得に多少時間がかかるため、別スレッドで実行します。
' (3) 別スレッドから画面のコントロールを操作します。
'     --> Delegateを宣言、Invokeで呼び出す
'------------------------------------------------------------------------
' VB.NETのマルチスレッドに関しては下記URLに具体的なサンプルがございます。
' http://codezine.jp/article/detail/135?p=1
'
' WMIに関しては下記URLを参考にしました。
' http://www.wmifun.net/library/win32_pnpentity.html
'************************************************************************

Imports System.Threading
Imports System.Management

Public Class Form1

    '================
    ' Win32 API 定数
    '================
    Private Const WM_DEVICECHANGE As Integer = &H219  'USBに抜き差しを検知

    '================
    ' フォームロード
    '================
    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        '-------------------------------------
        ' PaSoRi が接続済みの場合は情報を取得
        '-------------------------------------
        thread_GetWMI()
    End Sub

    '================================================
    ' 別スレッドから関数を呼び出すためのDelegate宣言
    '================================================
    Delegate Sub txtWMI_Clear_Delegate()
    Delegate Sub txtWMI_Show_Delegate(ByVal msg As String)

    '===================================================
    '【関数名】txtWMI_Clear
    '【引  数】なし
    '【戻り値】なし
    '---------------------------------------------------
    ' txtWMI.Text に表示されているメッセージを消去する。
    '===================================================
    Private Sub txtWMI_Clear()
        txtWMI.Text = ""
    End Sub

    '===========================================
    '【関数名】txtWMI_Show
    '【引  数】[in] String  表示するメッセージ
    '【戻り値】なし
    '-------------------------------------------
    ' txtWMI.Text に指定のメッセージを表示する。
    '===========================================
    Private Sub txtWMI_Show(ByVal msg As String)
        txtWMI.Text = msg
    End Sub

    '========================================================================
    '【関数名】WndProc
    '【引  数】System.Windows.Forms.Message  OSから送られたWindowsメッセージ
    '【戻り値】なし
    '------------------------------------------------------------------------
    ' Windowsメッセージを処理します。
    '========================================================================
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        '--------------------
        ' デバイス変更の検知
        '--------------------
        If m.Msg = WM_DEVICECHANGE Then
            '時間のかかる処理を別スレッドで実行
            Dim th As New Thread(New ThreadStart(AddressOf thread_GetWMI))
            th.Start()
            Return
        End If

        '----------------------------------------
        ' 上記以外の場合はメッセージを処理しない
        '----------------------------------------
        MyBase.WndProc(m)
    End Sub

    '===============================================================================
    '【関数名】thread_GetWMI
    '【引  数】なし
    '【戻り値】なし
    '-------------------------------------------------------------------------------
    ' WMIの情報を取得して、txtWMI.Textに表示する。
    ' デバイス名に PaSoRi が含まれていて、正常に動作しているものだけを抜き出します。
    '===============================================================================
    Private Sub thread_GetWMI()
        Try
            '--------------------------------
            ' Delegate宣言した関数の使用準備
            '--------------------------------
            Dim txtWMIClear As New txtWMI_Clear_Delegate(AddressOf txtWMI_Clear)
            Dim txtWMIShow As New txtWMI_Show_Delegate(AddressOf txtWMI_Show)

            '--------------------------------
            ' テキストボックスの情報をクリア
            '--------------------------------
            Invoke(txtWMIClear)

            '--------------------
            ' デバイス情報を取得
            '--------------------
            Dim oms As New ManagementObjectSearcher
            Dim omc As ManagementObjectCollection

            'デバイス名に PaSoRi が含まれていて、正常に動作しているものを検索する
            oms.Query.QueryString = "select * from Win32_PnPEntity " & _
                                    "where Name like '%PaSoRi%' and ConfigManagerErrorCode = 0"
            omc = oms.Get()

            Dim msg As String = ""

            For Each mo As ManagementObject In omc

                Dim list_CompatibleID As String()
                Dim list_HardwareID As String()
                Dim dt As New DateTime

                'Availability
                Select Case mo.Item("Availability")
                    Case 3
                        msg &= "Availability:[3] 電力 - 通常"
                    Case 4
                        msg &= "Availability:[4] 電力 - 警告"
                    Case 5
                        msg &= "Availability:[5] 電力 - テスト中"
                    Case 10
                        msg &= "Availability:[10] 電力 - 低下"
                    Case 13
                        msg &= "Availability:[13] 省電力 - 不明"
                    Case 14
                        msg &= "Availability:[14] 省電力 - 低電力モード"
                    Case 15
                        msg &= "Availability:[15] 省電力 - スタンバイ"
                    Case 17
                        msg &= "Availability:[17] 省電力 - 警告"
                    Case Else
                        msg &= "Availability:"
                End Select
                msg &= vbNewLine

                'Caption
                msg &= "Caption:" & mo.Item("Caption") & vbNewLine

                'ClassGuid
                msg &= "ClassGuid:" & mo.Item("ClassGuid") & vbNewLine

                'CompatibleID
                msg &= "CompatibleID:"
                If mo.Item("CompatibleID") IsNot Nothing Then
                    list_CompatibleID = mo.Item("CompatibleID")
                    For I As Integer = 0 To list_CompatibleID.Length() - 1
                        msg &= list_CompatibleID(I)

                        If I <> list_CompatibleID.Length() - 1 Then
                            msg &= ", "
                        End If
                    Next
                End If
                msg &= vbNewLine

                'ConfigManagerErrorCode
                Select Case mo.Item("ConfigManagerErrorCode")
                    Case 0
                        msg &= "ConfigManagerErrorCode:[0] " & _
                               "このデバイスは正常に動作しています。"
                    Case 1
                        msg &= "ConfigManagerErrorCode:[1] " & _
                               "このデバイスは正しく構成されていません。"
                    Case 2
                        msg &= "ConfigManagerErrorCode:[2] " & _
                               "このデバイスのドライバーを読み込めません。"
                    Case 3
                        msg &= "ConfigManagerErrorCode:[3] " & _
                               "このデバイスのドライバーは壊れているか、" & _
                               "あるいはメモリまたは他のリソースが不足している状態で" & _
                               "システムが実行されている可能性があります。"
                    Case 4
                        msg &= "ConfigManagerErrorCode:[4] " & _
                               "このデバイスは正常に動作していません。" & _
                               "ドライバーまたはレジストリが壊れている可能性があります。"
                    Case 5
                        msg &= "ConfigManagerErrorCode:[5] " & _
                               "このデバイスのドライバーには Windows が管理できないリソースが必要です。"
                    Case 6
                        msg &= "ConfigManagerErrorCode:[6] " & _
                               "このデバイスのブート構成が他のデバイスと競合しています。"
                    Case 7
                        msg &= "ConfigManagerErrorCode:[7] " & _
                               "フィルター処理できません。"
                    Case 8
                        msg &= "ConfigManagerErrorCode:[8] " & _
                               "デバイスのドライバー ローダーが見つかりません。"
                    Case 9
                        msg &= "ConfigManagerErrorCode:[9] " & _
                               "このデバイスを制御するファームウェアからリソースが正しく報告されないため、" & _
                               "このデバイスは正常に動作していません。"
                    Case 10
                        msg &= "ConfigManagerErrorCode:[10] " & _
                               "このデバイスを開始できません。"
                    Case 11
                        msg &= "ConfigManagerErrorCode:[11] " & _
                               "このデバイスはエラーで停止しました。"
                    Case 12
                        msg &= "ConfigManagerErrorCode:[12] " & _
                               "このデバイスで使用できる十分な空きリソースが見つかりません。"
                    Case 13
                        msg &= "ConfigManagerErrorCode:[13] " & _
                               "このデバイスのリソースを確認できません。"
                    Case 14
                        msg &= "ConfigManagerErrorCode:[14] " & _
                               "コンピューターを再起動するまでこのデバイスは正常に動作しません。"
                    Case 15
                        msg &= "ConfigManagerErrorCode:[15] " & _
                               "このデバイスは、再列挙に問題が発生している可能性があり、" & _
                               "正常に動作していません。"
                    Case 16
                        msg &= "ConfigManagerErrorCode:[16] " & _
                               "このデバイスで使用される一部のリソースを認識できません。"
                    Case 17
                        msg &= "ConfigManagerErrorCode:[17] " & _
                               "このデバイスは不明なリソースの種類を要求しています。"
                    Case 18
                        msg &= "ConfigManagerErrorCode:[18] " & _
                               "このデバイスのドライバーを再インストールしてください。"
                    Case 19
                        msg &= "ConfigManagerErrorCode:[19] " & _
                               "レジストリが壊れている可能性があります。"
                    Case 20
                        msg &= "ConfigManagerErrorCode:[20] " & _
                               "VxD ローダーの使用に失敗しました。"
                    Case 21
                        msg &= "ConfigManagerErrorCode:[21] " & _
                               "システム エラー: このデバイスのドライバーを変更してみてください。" & _
                               "うまくいかない場合はハードウェアのマニュアルを参照してください。" & _
                               "このデバイスは削除されます。"
                    Case 22
                        msg &= "ConfigManagerErrorCode:[22] " & _
                               "このデバイスは無効になっています。"
                    Case 23
                        msg &= "ConfigManagerErrorCode:[23] " & _
                               "システム障害: このデバイスのドライバーを変更してみてください。" & _
                               "うまくいかない場合はハードウェアのマニュアルを参照してください。"
                    Case 24
                        msg &= "ConfigManagerErrorCode:[24] " & _
                               "このデバイスは存在しないか、正常に動作していないか、" & _
                               "または一部のドライバーがインストールされていません。"
                    Case 25
                        msg &= "ConfigManagerErrorCode:[25] " & _
                               "このデバイスはまだセットアップ処理中です。"
                    Case 26
                        msg &= "ConfigManagerErrorCode:[26] " & _
                               "このデバイスはまだセットアップ処理中です。"
                    Case 27
                        msg &= "ConfigManagerErrorCode:[27] " & _
                               "このデバイスに有効なログ構成がありません。"
                    Case 28
                        msg &= "ConfigManagerErrorCode:[28] " & _
                               "このデバイスのドライバーはインストールされていません。"
                    Case 29
                        msg &= "ConfigManagerErrorCode:[29] " & _
                               "このデバイスは、必要なリソースがデバイスのファームウェアから" & _
                               "提供されなかったため無効になっています。"
                    Case 30
                        msg &= "ConfigManagerErrorCode:[30] " & _
                               "このデバイスは、他のデバイスが使用している" & _
                               "割り込み要求 (IRQ) リソースを使用しています。"
                    Case 31
                        msg &= "ConfigManagerErrorCode:[31] " & _
                               "このデバイスは、このデバイスに必要なドライバーを" & _
                               "読み込めないため正常に動作していません。"
                    Case Else
                        msg &= "ConfigManagerErrorCode:"
                End Select
                msg &= vbNewLine

                'ConfigManagerUserConfig
                If mo.Item("ConfigManagerUserConfig") Then
                    msg &= "ConfigManagerUserConfig:[TRUE] " & _
                           "デバイスがユーザー定義の構成を使用しています。"
                Else
                    msg &= "ConfigManagerUserConfig:[FALSE] " & _
                           "デバイスがユーザー定義の構成を使用していません。"
                End If
                msg &= vbNewLine

                'CreationClassName
                msg &= "CreationClassName:" & mo.Item("CreationClassName") & vbNewLine

                'Description
                msg &= "Description:" & mo.Item("Description") & vbNewLine

                'DeviceID
                msg &= "DeviceID:" & mo.Item("DeviceID") & vbNewLine

                'ErrorCleared
                If mo.Item("ErrorCleared") Then
                    msg &= "ErrorCleared:[TRUE] " & _
                           "LastErrorCode プロパティで報告されたエラーが現在解決されています。"
                Else
                    msg &= "ErrorCleared:[FALSE] " & _
                           "LastErrorCode プロパティで報告されたエラーが現在解決されていません。"
                End If
                msg &= vbNewLine

                'ErrorDescription
                msg &= "ErrorDescription:" & mo.Item("ErrorDescription") & vbNewLine

                'HardwareID
                msg &= "HardwareID:"
                If mo.Item("HardwareID") IsNot Nothing Then
                    list_HardwareID = mo.Item("HardwareID")
                    For I As Integer = 0 To list_HardwareID.Length() - 1
                        msg &= list_HardwareID(I)

                        If I <> list_HardwareID.Length() - 1 Then
                            msg &= ", "
                        End If
                    Next
                End If
                msg &= vbNewLine

                'InstallDate
                If mo.Item("InstallDate") Is Nothing Then
                    msg &= "InstallDate:"
                Else
                    dt = mo.Item("InstallDate")
                    msg &= "InstallDate:" & _
                           String.Format("{0:0000}/{1:00}/{2:00} {3:00}:{4:00}:{5:00}", _
                                         dt.Year, dt.Month, dt.Day, dt.Hour, dt.Minute, dt.Second)
                End If
                msg &= vbNewLine

                'LastErrorCode
                msg &= "LastErrorCode:" & CStr(mo.Item("LastErrorCode")) & vbNewLine

                'Manufacturer
                msg &= "Manufacturer:" & mo.Item("Manufacturer") & vbNewLine

                'Name
                msg &= "Name:" & mo.Item("Name") & vbNewLine

                'PNPDeviceID
                msg &= "PNPDeviceID:" & mo.Item("PNPDeviceID") & vbNewLine

                'PowerManagementCapabilities
                Select Case mo.Item("PowerManagementCapabilities")
                    Case 0
                        msg &= "PowerManagementCapabilities:[0] 不明"
                    Case 1
                        msg &= "PowerManagementCapabilities:[1] サポートされていません"
                    Case 2
                        msg &= "PowerManagementCapabilities:[2] 無効"
                    Case 3
                        msg &= "PowerManagementCapabilities:[3] 有効"
                    Case 4
                        msg &= "PowerManagementCapabilities:[4] 自動省電力モード"
                    Case 5
                        msg &= "PowerManagementCapabilities:[5] 電源の状態設定可能"
                    Case 6
                        msg &= "PowerManagementCapabilities:[6] 電源サイクル サポート"
                    Case 7
                        msg &= "PowerManagementCapabilities:[7] 時刻指定電源オン サポート"
                    Case Else
                        msg &= "PowerManagementCapabilities:"
                End Select
                msg &= vbNewLine

                'PowerManagementSupported
                If mo.Item("PowerManagementSupported") Then
                    msg &= "PowerManagementSupported:[TRUE] " & _
                           "デバイスの電源管理が可能。"
                Else
                    msg &= "PowerManagementSupported:[FALSE] " & _
                           "デバイスの電源管理がサポートされていません。"
                End If
                msg &= vbNewLine

                'Service
                msg &= "Service:" & mo.Item("Service") & vbNewLine

                'Status
                msg &= "Status:" & mo.Item("Status") & vbNewLine

                'StatusInfo
                Select Case mo.Item("StatusInfo")
                    Case 1
                        msg &= "StatusInfo:[1]その他の状態"
                    Case 2
                        msg &= "StatusInfo:[2]不明な状態"
                    Case 3
                        msg &= "StatusInfo:[3]論理デバイスが有効"
                    Case 4
                        msg &= "StatusInfo:[4]無効"
                    Case 5
                        msg &= "StatusInfo:[5]該当なし"
                    Case Else
                        msg &= "StatusInfo:"
                End Select
                msg &= vbNewLine

                'SystemCreationClassName
                msg &= "SystemCreationClassName:" & mo.Item("SystemCreationClassName") & vbNewLine

                'SystemName
                msg &= "SystemName:" & mo.Item("SystemName") & vbNewLine
                msg &= vbNewLine
            Next

            '------------------
            ' 画面に情報を表示
            '------------------
            Invoke(txtWMIShow, New Object() {msg})
        Catch ex As Exception
            MessageBox.Show(ex.Message, Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
        End Try
    End Sub
End Class



WndProc () について

Windows のデスクトップアプリでは、キーボードでキー入力したりボタンをクリックした時などに
その都度、Windowsメッセージが発生し、それを処理する事でプログラムが動いています。

USBデバイスが抜き差しされた時も例外ではなく、Windowsメッセージが飛んできます。
それを処理する事で、目的のデバイスが現在パソコンにつながっているかどうか確認することができます。

ただし、時間のかかる処理は WndProc () 関数内でしない方がいいです。
なぜなら、Windowsメッセージは常にやり取りされているのですが
1つの処理で時間がかかると次のメッセージを処理するまで待機状態になります。
要するに、プログラムが固まってしまいます。

それを防ぐためにも時間のかかる処理は別スレッドで実行した方がいいでしょう。


マルチスレッド、WMIに関して

VB.NETのマルチスレッドに関しては下記URLに具体的なサンプルがございます。
http://codezine.jp/article/detail/135?p=1

WMIに関しては下記URLを参考にしました。
http://www.wmifun.net/library/win32_pnpentity.html


スポンサーサイト




テーマ:プログラミング | ジャンル:コンピュータ | カテゴリー:VB.NET | タグ:
コメント(0)トラックバック (0) | 2013年09月28日 (土)10時03分

VB.NET で felicalib.dll を使ってみる

このページの目標

(1) まずパソコンに PaSoRi をつないで…



(2) 携帯の FeLiCa (おサイフケータイ)を認識させた状態にして…



(3) ソフトを起動し、FeliCa 読み取りボタンをクリックすると…



(4) IDm, PMm が表示されることを目指します!



PaSoRi を使って Felica にアクセスするには?

PaSoRi を使って Felica の IDM, PMm を読み取るために、VB.NET で自作ソフトを作ってみようと思いました。
しかし、PaSoRi を直接操作して Felica の内容を読み取る手段がありません…

そこで、発見したのが felicalib.dll です。
felicalib.dll を仲介して PaSoRi を操作します。

イメージ的にはこんな感じでアクセスします。



felicalib.dll とは?

PaSoRi を使って FeliCa のデータを読み書きするためのライブラリです。 有志の方が作られました。

今でこそ Sony の公式サイト から SDK for NFC Starter Kit を無償でダウンロードできますが
以前は、お値段が10万円以上で法人しか入手できなかったようです。
そのため、無償で使える felicalib.dll が開発されたみたいです。

また、SDK for NFC Starter Kit を使えば PaSoRi RC-S370 以前の型番だと操作できましたが
最新の PaSoRi RC-S380 は操作できなくなっています。
felica_nfc_library.dllPaSoRi RC-S380 に未対応で、ライブラリの初期化に失敗するのが原因みたいです。

しかし、felicalib.dll では PaSoRi RC-S380 も含めて IDm、PMm の取得、フリー領域の読み書きはできます。

以上の理由から、今回は felicalib.dll を使わせて頂きます。

プログラム作成に必要な物

(1) Visual Basic 2005, 2008, 2010, 2012 のいずれかで Express Edition がインストールされていれば十分です。
     プロジェクトを新規作成する時に、ターゲットとなる .NET Framework のバージョンは 2.0 でかまいません。

(2) FeliCaポートソフトウェア がインストールされていること。
     PaSoRi があれば、付属のCDにドライバが入ってるはずなので、そこからインストールして下さい。
     手元にCDがない場合は こちら からダウンロードしてインストールして下さい。

(3) PaSoRi がパソコンに接続されていること。
     対応機種: RC-S380 / S370 / S330 / S320

(4) felicalib.dll がダウンロードされていること。
     こちら から felicalib-0.4.2.zip をダウンロードして下さい。
     解凍して felicalib.dll を実行ファイル(exe)と同じフォルダに入れれば完了です。




VB.NET で felicalib.dll を使うためのサンプル

felicalib.dll を使うためのサンプルは C/C++, C# 対応のものはありますが、VB.NET 対応のものがなかったので作ってみました。
modFelicaLib.vb がプログラムの中心になります。

使いたい人がいるかはわかりませんが、自由に使って頂いて結構です (^^;
VB 2005 (.NET Framework 2.0) 以降を対象としています。

[ Visual Basic .NET ]



[ Form1.vb ]
Public Class Form1
    '======================
    ' felicalib.dll クラス
    '======================
    Private felicalib As New CFelicaLib

    '================
    ' フォームロード
    '================
    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        '------------------
        ' DLL 存在チェック
        '------------------
        If Not isDLLExists() Then
            MessageBox.Show("felicalib.dll がありません。", Me.Text)
            Application.Exit()
        End If

        '------------------
        ' ボタンの名前変更
        '------------------
        btnFelica.Text = "FeliCa 読み取り"
    End Sub

    '======================
    ' ボタン・クリック処理
    '======================
    Private Sub btnFelica_Click(sender As System.Object, e As System.EventArgs) Handles btnFelica.Click
        Dim sIDm As String
        Dim sPMm As String
        Dim sMsg As String

        '-------------------
        ' PaSoRi に接続する
        '-------------------
        If Not felicalib.Pasori_Connect() Then
            MessageBox.Show("PaSoRi に接続できませんでした。", Me.Text)
            Return
        End If

        '----------------------------
        ' ポーリング(FeliCa読み取り)
        '----------------------------
        If felicalib.Polling() Then
            '-----------------
            ' IDm, PMm を取得
            '-----------------
            sIDm = felicalib.getIDm()
            sPMm = felicalib.getPMm()

            '------------------
            ' メッセージを表示
            '------------------
            sMsg = "IDm=[" & sIDm & "]" & vbNewLine & _
                   "PMm=[" & sPMm & "]"
            MessageBox.Show(sMsg, Me.Text)
        Else
            '--------------------------
            ' ポーリングに失敗した場合
            '--------------------------
            MessageBox.Show("FeliCa がセットされていません。", Me.Text)
        End If

        '-------------------
        ' PaSoRi を解放する
        '-------------------
        felicalib.Pasori_Free()
    End Sub
End Class


[ modFelicaLib.vb ]
Imports System.Runtime.InteropServices
Imports UInt8 = System.Byte

Module modFelicaLib
    Private Const MAX_SYSTEM_CODE = 8
    Private Const MAX_AREA_CODE = 16
    Private Const MAX_SERVICE_CODE = 256

    '-------------------------------
    ' FeliCa の情報を格納する構造体
    '-------------------------------
    <StructLayout(LayoutKind.Sequential)> _
    Private Structure felica
        Public p As IntPtr           'PaSoRi ハンドル
        Public systemcode As UInt16  'システムコード
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=8)> _
        Public IDm() As UInt8        'IDm
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=8)> _
        Public PMm() As UInt8        'PMm

        'systemcode
        Public num_system_code As UInt8      '列挙システムコード数
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=MAX_SYSTEM_CODE)> _
        Public system_code() As UInt16       '列挙システムコード

        'area/service codes
        Public num_area_code As UInt8        'エリアコード数
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=MAX_AREA_CODE)> _
        Public area_code() As UInt16         'エリアコード
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=MAX_AREA_CODE)> _
        Public end_service_code() As UInt16  'エンドサービスコード

        Public num_service_code As UInt8     'サービスコード数
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=MAX_SERVICE_CODE)> _
        Public service_code() As UInt16      'サービスコード
    End Structure

    '-----------
    ' constants
    '-----------
    'システムコード (ネットワークバイトオーダ/ビックエンディアンで表記)
    Private Const POLLING_ANY = &HFFFF
    Private Const POLLING_EDY = &HFE00  'システムコード: 共通領域 (Edyなどが使用)
    Private Const POLLING_SUICA = &H3   'システムコード: サイバネ領域

    '------
    ' APIs
    '------
    '【関 数 名】pasori_open
    '【第1引数】[in] dummy
    '【戻 り 値】pasori  ハンドル
    <DllImport("felicalib.dll")> _
    Private Function pasori_open(ByVal dummy As IntPtr) As IntPtr
    End Function

    '【関 数 名】pasori_close
    '【第1引数】[in] p  pasoriハンドル (pasori_open で得たポインタを指定する)
    <DllImport("felicalib.dll")> _
    Private Sub pasori_close(ByVal p As IntPtr)
    End Sub

    '【関 数 名】InteropServices
    '【第1引数】[in] p  pasoriハンドル (pasori_open で得たポインタを指定する)
    '【戻 り 値】エラーコード
    <DllImport("felicalib.dll")> _
    Private Function pasori_init(ByVal p As IntPtr) As Integer
    End Function

    '【関 数 名】felica_polling
    '【第1引数】[in] p           pasoriハンドル (pasori_open で得たポインタを指定する)
    '【第2引数】[in] systemcode  システムコード
    '【第3引数】[in] RFU         RFU (使用しない)
    '【第4引数】[in] timeslot    タイムスロット
    '【戻 り 値】felicaハンドル (MarshalクラスのPtrToStructureメソッドを使用)
    <DllImport("felicalib.dll")> _
    Private Function felica_polling( _
        ByVal p As IntPtr, _
        ByVal systemcode As UInt16, _
        ByVal RFU As UInt8, _
        ByVal timeslot As UInt8 _
    ) As IntPtr
    End Function

    '【関 数 名】felica_free
    '【第1引数】[in] f  felicaハンドル (felica構造体のポインタを指定する)
    <DllImport("felicalib.dll")> _
    Private Sub felica_free(ByVal f As IntPtr)
    End Sub

    '【関 数 名】felica_getidm
    '【第1引数】[in]  f   felicaハンドル (felica構造体のポインタを指定する)
    '【第2引数】[out] buf IDm を格納するバッファ(8バイト)
    <DllImport("felicalib.dll")> _
    Private Sub felica_getidm(ByVal f As IntPtr, ByVal buf As IntPtr)
    End Sub

    '【関 数 名】felica_getpmm
    '【第1引数】[in]   f    felicaハンドル (felica構造体のポインタを指定する)
    '【第2引数】[out]  buf  PMm を格納するバッファ(8バイト)
    <DllImport("felicalib.dll")> _
    Private Sub felica_getpmm(ByVal f As IntPtr, ByVal buf As IntPtr)
    End Sub

    '【関 数 名】felica_read_without_encryption02
    '【第1引数】[in]   f            felicaハンドル (felica構造体のポインタを指定する)
    '【第2引数】[in]   servicecode  サービスコード
    '【第3引数】[in]   mode         モード(使用しない)
    '【第4引数】[in]   addr         ブロック番号
    '【第5引数】[out]  data         データ(16バイト)
    '【戻 り 値】エラーコード
    <DllImport("felicalib.dll")> _
    Private Function felica_read_without_encryption02( _
        ByVal f As IntPtr, _
        ByVal servicecode As Integer, _
        ByVal mode As Integer, _
        ByVal addr As UInt8, _
        ByVal buf As IntPtr _
    ) As Integer
    End Function

    '【関 数 名】felica_write_without_encryption
    '【第1引数】[in]   f            felicaハンドル (felica構造体のポインタを指定する)
    '【第2引数】[in]   servicecode  サービスコード
    '【第3引数】[in]   mode         モード(使用しない)
    '【第4引数】[in]   addr         ブロック番号
    '【第5引数】[out]  data         データ(16バイト)
    '【戻 り 値】エラーコード
    <DllImport("felicalib.dll")> _
    Private Function felica_write_without_encryption( _
        ByVal f As IntPtr, _
        ByVal servicecode As Integer, _
        ByVal addr As UInt8, _
        ByVal buf As IntPtr _
    ) As Integer
    End Function

    '【関 数 名】felica_enum_systemcode
    '【第1引数】[in]  p  pasoriハンドル (pasori_open で得たポインタを指定する)
    '【戻 り 値】felicaハンドル (felica構造体のポインタを指定する)
    <DllImport("felicalib.dll")> _
    Private Function felica_enum_systemcode(ByVal p As IntPtr) As IntPtr
    End Function

    '【関 数 名】felica_enum_service
    '【第1引数】[in]  p           pasoriハンドル (pasori_open で得たポインタを指定する)
    '【第2引数】[in]  systemcode  システムコード
    '【戻 り 値】felicaハンドル (felica構造体のポインタを指定する)
    <DllImport("felicalib.dll")> _
    Private Function felica_enum_service(ByVal p As IntPtr, ByVal systemcode As UInt16) As IntPtr
    End Function


    '===================================
    ' Win32 API (DLL存在チェックに必要)
    '===================================
    <DllImport("kernel32")> _
    Private Function SetDllDirectory(ByVal lpPathName As String) As Boolean
    End Function

    <DllImport("kernel32")> _
    Private Function LoadLibrary(ByVal lpLibFileName As String) As Integer
    End Function

    <DllImport("kernel32")> _
    Private Function GetProcAddress(ByVal hModule As Integer, ByVal lpProcName As String) As Integer
    End Function

    <DllImport("kernel32")> _
    Private Function FreeLibrary(ByVal hLibModule As Integer) As Boolean
    End Function

    '====================================================
    '【関数名】isDLLExists
    '【引  数】なし
    '【戻り値】[out] Boolean  TRUE   DLLの読み込みに成功
    '                         FALSE  DLLの読み込みに失敗
    '----------------------------------------------------
    ' felicalib.dll が存在するかチェックする。
    '====================================================
    Public Function isDLLExists() As Boolean
        'DLLのハンドル
        Dim hModule As IntPtr = IntPtr.Zero

        'DLL内の関数を受け取るポインタ
        Dim pPasoriOpen                    As IntPtr = IntPtr.Zero
        Dim pPasoriClose                   As IntPtr = IntPtr.Zero
        Dim pPasoriInit                    As IntPtr = IntPtr.Zero
        Dim pFelicaPolling                 As IntPtr = IntPtr.Zero
        Dim pFelicaFree                    As IntPtr = IntPtr.Zero
        Dim pFelicaGetidm                  As IntPtr = IntPtr.Zero
        Dim pFelicaGetpmm                  As IntPtr = IntPtr.Zero
        Dim pFelicaReadWithoutEncryption02 As IntPtr = IntPtr.Zero
        Dim pFelicaWriteWithoutEncryption  As IntPtr = IntPtr.Zero
        Dim pFelicaEnumSystemcode          As IntPtr = IntPtr.Zero
        Dim pFelicaEnumService             As IntPtr = IntPtr.Zero

        Try
            'DLLプリロード対策 ※DLLの読み込み先から現在の作業ディレクトリ(CWD)を除外する
            SetDllDirectory("")

            'DLLを読み込む
            hModule = LoadLibrary("felicalib.dll")
            If hModule = IntPtr.Zero Then
                Return False
            End If

            'DLLの関数を読み込む
            pPasoriOpen                    = GetProcAddress(hModule, "pasori_open")
            pPasoriClose                   = GetProcAddress(hModule, "pasori_close")
            pPasoriInit                    = GetProcAddress(hModule, "pasori_init")
            pFelicaPolling                 = GetProcAddress(hModule, "felica_polling")
            pFelicaFree                    = GetProcAddress(hModule, "felica_free")
            pFelicaGetidm                  = GetProcAddress(hModule, "felica_getidm")
            pFelicaGetpmm                  = GetProcAddress(hModule, "felica_getpmm")
            pFelicaReadWithoutEncryption02 = GetProcAddress(hModule, "felica_read_without_encryption02")
            pFelicaWriteWithoutEncryption  = GetProcAddress(hModule, "felica_write_without_encryption")
            pFelicaEnumSystemcode          = GetProcAddress(hModule, "felica_enum_systemcode")
            pFelicaEnumService             = GetProcAddress(hModule, "felica_enum_service")

            If pPasoriOpen                    = IntPtr.Zero OrElse _
               pPasoriClose                   = IntPtr.Zero OrElse _
               pPasoriInit                    = IntPtr.Zero OrElse _
               pFelicaPolling                 = IntPtr.Zero OrElse _
               pFelicaFree                    = IntPtr.Zero OrElse _
               pFelicaGetidm                  = IntPtr.Zero OrElse _
               pFelicaGetpmm                  = IntPtr.Zero OrElse _
               pFelicaReadWithoutEncryption02 = IntPtr.Zero OrElse _
               pFelicaWriteWithoutEncryption  = IntPtr.Zero OrElse _
               pFelicaEnumSystemcode          = IntPtr.Zero OrElse _
               pFelicaEnumService             = IntPtr.Zero _
            Then
                FreeLibrary(hModule)
                Return False
            End If

            '読み込み成功
            FreeLibrary(hModule)
            Return True
        Catch ex As Exception
            MessageBox.Show(ex.Message, "isDLLExists()")
            If hModule <> IntPtr.Zero Then FreeLibrary(hModule)
            Return False
        End Try
    End Function

    '=============================================
    '【関 数 名】hexdump
    '【第1引数】[in]  UInt8()  データ配列
    '【第2引数】[in]  Integer  配列のサイズ
    '【戻 り 値】[out] String   16進数文字列
    '---------------------------------------------
    ' 受け取ったデータを16進数の文字列に変換する。
    '=============================================
    Private Function hexdump(ByVal arg() As UInt8, ByVal size As Integer) As String
        Dim sResult As String = ""

        For I As Integer = 0 To size - 1
            sResult &= arg(I).ToString("X2")
        Next

        Return sResult
    End Function

    '================================
    ' felicalib.dll アクセス用クラス
    '================================
    Class CFelicaLib
        Implements IDisposable 'デストラクタ

        '==========
        ' 変数定義
        '==========
        Private p_ptr As IntPtr  'Pasoriポインタ
        Private f_ptr As IntPtr  'felica構造体ポインタ

        '===========================================
        '【関数名】New
        '【引  数】なし
        '【戻り値】なし
        '-------------------------------------------
        ' コンストラクタ。ポインタの初期化を行なう。
        '===========================================
        Public Sub New()
            '初期化
            p_ptr = IntPtr.Zero
            f_ptr = IntPtr.Zero
        End Sub

        '=================================
        '【関数名】Dispose
        '【引  数】なし
        '【戻り値】なし
        '---------------------------------
        ' デストラクタ。PaSoRiを解放する。
        '=================================
        Public Sub Dispose() Implements IDisposable.Dispose
            'PaSoRi の接続を解放
            Pasori_Free()
        End Sub

        '===============================================
        '【関数名】Pasori_Connect
        '【引  数】なし
        '【戻り値】[out] Boolean  TRUE   PaSoRi接続成功
        '                         FALSE  PaSoRi接続失敗
        '-----------------------------------------------
        ' PaSoRiに接続して使用可能な状態にする。
        '===============================================
        Public Function Pasori_Connect() As Boolean
            Try
                '----------------------
                ' PaSoRi ハンドル取得
                '----------------------
                p_ptr = pasori_open(Nothing)
                If p_ptr = IntPtr.Zero Then
                    Return False
                End If

                '---------------------
                ' PaSoRi 初期化(接続)
                '---------------------
                If pasori_init(p_ptr) <> 0 Then
                    Return False
                End If

                Return True
            Catch ex As Exception
                MessageBox.Show(ex.Message, "Pasori_Connect()")
                Return False
            End Try
        End Function

        '======================
        '【関数名】Pasori_Free
        '【引  数】なし
        '【戻り値】なし
        '----------------------
        ' PaSoRiの接続を解放
        '======================
        Public Sub Pasori_Free()
            Try
                If f_ptr <> IntPtr.Zero Then felica_free(f_ptr)
                If p_ptr <> IntPtr.Zero Then pasori_close(p_ptr)
            Catch ex As Exception
                MessageBox.Show(ex.Message, "Pasori_Free()")
            End Try
        End Sub

        '===========================================================
        '【関数名】Polling
        '【引  数】なし
        '【戻り値】[out] Boolean  TRUE   felicaハンドルの取得に成功
        '                         FALSE  felicaハンドルの取得に失敗
        '-----------------------------------------------------------
        ' ポーリング。FeliCaの読み取り準備。
        '===========================================================
        Public Function Polling() As Boolean
            Try
                '--------------------------------
                ' felicaハンドルを一度クリアする
                '--------------------------------
                If f_ptr <> IntPtr.Zero Then
                    felica_free(f_ptr)
                End If

                '------------
                ' ポーリング
                '------------
                f_ptr = felica_polling(p_ptr, POLLING_ANY, 0, 0)

                '------------
                ' 結果を返す
                '------------
                If f_ptr = IntPtr.Zero Then
                    Return False
                Else
                    Return True
                End If
            Catch ex As Exception
                MessageBox.Show(ex.Message, "Polling()")
                Return False
            End Try
        End Function

        '====================================
        '【関数名】getIDm
        '【引  数】なし
        '【戻り値】[out] String  FeliCaのIDm
        '------------------------------------
        ' FeliCaのIDmを取得する。
        '====================================
        Public Function getIDm() As String
            Try
                '------------
                ' エラー処理
                '------------
                If f_ptr = IntPtr.Zero Then
                    Return ""
                End If

                '-------------
                ' IDm読み取り
                '-------------
                Dim IDm As String
                Dim buf(8) As UInt8

                '---------------------
                ' bufのアドレスを取得
                '---------------------
                Dim gch As GCHandle = GCHandle.Alloc(buf, GCHandleType.Pinned)
                Dim b As IntPtr = gch.AddrOfPinnedObject().ToInt32

                felica_getidm(f_ptr, b)
                IDm = hexdump(buf, 8)
                gch.Free()

                Return IDm
            Catch ex As Exception
                MessageBox.Show(ex.Message, "getIDm()")
                Return ""
            End Try
        End Function

        '====================================
        '【関数名】getPMm
        '【引  数】なし
        '【戻り値】[out] String  FeliCaのPMm
        '------------------------------------
        ' FeliCaのPMmを取得する。
        '====================================
        Public Function getPMm() As String
            Try
                '------------
                ' エラー処理
                '------------
                If f_ptr = IntPtr.Zero Then
                    Return ""
                End If

                '-------------
                ' PMm読み取り
                '-------------
                Dim PMm As String
                Dim buf(8) As UInt8

                '---------------------
                ' bufのアドレスを取得
                '---------------------
                Dim gch As GCHandle = GCHandle.Alloc(buf, GCHandleType.Pinned)
                Dim b As IntPtr = gch.AddrOfPinnedObject().ToInt32

                felica_getpmm(f_ptr, b)
                PMm = hexdump(buf, 8)
                gch.Free()

                Return PMm
            Catch ex As Exception
                MessageBox.Show(ex.Message, "getIDm()")
                Return ""
            End Try
        End Function

        '======================================
        '【関 数 名】getIDmPMm
        '【第1引数】[out] String  FeliCaのIDm
        '【第2引数】[out] String  FeliCaのPMm
        '【戻 り 値】なし
        '--------------------------------------
        ' FeliCaのIDmとPMmを同時に取得する。
        '======================================
        Public Sub getIDmPMm(ByRef IDm As String, ByRef PMm As String)
            Try
                '------------
                ' エラー処理
                '------------
                If f_ptr = IntPtr.Zero Then
                    IDm = ""
                    PMm = ""
                    Return
                End If

                '--------------------------
                ' felica構造体の実体を取得
                '--------------------------
                Dim f As felica = Marshal.PtrToStructure(f_ptr, GetType(felica))

                '------------------
                ' IDm・PMm読み取り
                '------------------
                IDm = hexdump(f.IDm, 8)
                PMm = hexdump(f.PMm, 8)
            Catch ex As Exception
                MessageBox.Show(ex.Message, "getIDmPMm()")
                IDm = ""
                PMm = ""
            End Try
        End Sub
    End Class
End Module


DllImport について

DLL がない場合、DllImport しただけではエラーは発生しません。
実際にその関数を使おうとしたタイミングで例外が発生し、プログラムが異常終了します。
DllImport した関数を使う場合は Try Catch 文で例外を処理するようにして下さい。


構造体固定長の配列 を宣言する方法

構造体の中で配列を宣言する場合、VB.NETでは要素数を指定できません。
通常は次のように宣言せざるをえません。
Structure Sample
    Dim buf() As UInt16

    Public Sub Initialize()
        ReDim buf(8)
    End Sub
End Structure

しかし、C , C++ で作られた DLLVB.NET から使う場合、
データをやりとりするために配列の要素数を固定しなければいけない時があります。
そのため、VB.NET の構造体で 固定長の配列 を強引に宣言するサンプルを示します。
Structure Sample
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=8)> _
    Public buf() As UInt16

    Public Sub Initialize()
        ReDim buf(8)
    End Sub
End Structure

これで、構造体の中はOKです。 しかし、まだ問題があります。
実はこの構造体、.NET Framework (マネージ環境) に対応した構造体なのです。
これは アンマネージ環境 の構造体と互換性がありません。
では、アンマネージ互換 の構造体を宣言してみましょう。
<StructLayout(LayoutKind.Sequential)> _
Structure Sample
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=8)> _
    Public buf() As UInt16

    Public Sub Initialize()
        ReDim buf(8)
    End Sub
End Structure

先頭に  <StructLayout(LayoutKind.Sequential)>  が付いただけですね (^^;
これで .NET Framework 以外の環境とデータをやりとりできます。


.NET Framework 4.0 でDLLを呼び出すとエラーが出る?? (2014/10/26 追記)
.NET Framework 2.0~3.5 の実行環境は CLR2.0 でした。
しかし、.NET Framework 4.0 で CLR のバージョンが一新されました。
その結果、DLLImport による DLL の呼び出し規約がより厳しくなったようです。

具体的には以下のように書き直さないと実行時にエラーが出ます。
変更前 <DllImport("DLL名")>
変更後 <DllImport("DLL名", CallingConvention:=CallingConvention.Cdecl)>

Win32API を呼び出す場合は下記のように呼び出します。
変更前 <DllImport("DLL名")>
変更後 <DllImport("DLL名", CallingConvention:=CallingConvention.StdCall)>

(), の位置がおかしかったので修正しました


コンパイル時の .NET Framework のバージョンについて (2014/10/26 追記)
.NET Framework 2.0~3.5 をターゲットにコンパイルされた場合、実行環境は CLR2.0 になります。
Windows Vista / 7 は最初から OS に .NET Framework 2.0 がインストールされています。
Windows 8 / 8.1 の場合は コントロールパネル>プログラムと機能>Windowsの機能の有効化または無効化 で
.NET Framework 3.5(.NET 2.0 および 3.0 を含む) を選択してインストールして下さい。

.NET Framework 4.0~4.5 をターゲットにコンパイルされた場合、実行環境は CLR4 になります。
Windows Vista / 7 の場合は .NET Framework 4.0 または 4.5 をインストールして下さい。
Windows 8 / 8.1 は最初から OS に .NET Framework 4.5 がインストールされています。

それぞれ対応したバージョンの実行環境(CLR)がないと実行時にエラーが出るはずです。


サンプル公開 (2014/10/26 追記)
Visual Studio 2010 でサンプルを作ってみました。
こちら のページの felicalib_sample.zip からダウンロードできます。
.NET Framework 2.0 でコンパイルするように設定していますが、後で .NET Framework 4.0 に変更することもできます。

ただし、32ビット(x86)でコンパイルするようにして下さい。
詳しい解説は こちら にございますので、参考にして下さい。


FelicaDump に関して (2015/2/23 追記)
felicalib.dll を配布しているサイトで、Felica の情報をダンプするプログラム FelicaDump.exe が公開されています。
これを元に VB.NET でプログラムを作ってみました。

こちら のページの felicadump_sample.zip からダウンロードできます。
何かの役に立てば幸いです。

ただし、コメント欄でご意見を頂いたように (Protected) となっている部分は情報を取得できません。
おそらく暗号化部分はアクセス不可になっているためと思われますが、詳しい原因はわかりません。

試しに、C言語で書かれた FelicaDump.exe のソースコードを Debug モードでコンパイルしてみると
今回、私が作った VB.NET のプログラムと同じ結果になるんですけどね… (^^;

FelicaDump.exe のソースコードを Release モードでコンパイルすると結果が違うのも気になります。
おそらく、VC++の最適化処理で予期しないコードが生成されているのでしょう。

結局、詳しい原因がわからないままで申し訳ございません…


リンク先を変更しました (2018/1/11 追記)
サンプルのリンク先が切れていたようなので修正しました。

また、おまけとして felicalib.dll を使わず、Windowsの標準機能だけを使って Felica の IDm を読むサンプルも置いておきました。
こちら のページの nfc_pcsc_sample.zip からダウンロードできますので参考になれば幸いです。

ただし、このサンプルは Windows7 以降の winscard.dll に実装されている PC/SC という機能を使っています。
これは、NFC という国際規格を使ってICカードと通信するための仕組みです。

そのため、nfc_pcsc_sample.zipWindows7 以降にのみ対応しています。



テーマ:プログラミング | ジャンル:コンピュータ | カテゴリー:VB.NET | タグ:
コメント(6)トラックバック (1) | 2013年09月27日 (金)10時01分