ferica_non_protected_area_read_write.vb

'================
' Felicaの非保護領域に任意のデータを書き込むテストプログラム
' 2016年03月20日 7M4MON
' 
' 白執事さんの下記ページのプログラムをちょっと変更して読み書き出来るようにした。
' http://siroshitsuji.blog.fc2.com/blog-entry-18.html
'================

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

        '------------------
        ' ボタンの名前変更
        '------------------
        btnFelica.Text = "Raad"
    End Sub

    '======================
    ' 読み込みボタン・クリック処理
    '======================
    Private Sub btnFelica_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFelica.Click
        '----------
        ' 変数定義
        '----------
        Dim felicalib As New CFelicaLib
        Dim sIDm As String
        'Dim sPMm As String
        Dim sMsg As String
        Dim sStr As String

        Dim sServicecode As Integer = Convert.ToInt32(tbServce.Text, 16)
        Dim sBlock As Integer = Convert.ToInt32(tbBlock.Text, 16)

        '-------------------
        ' 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()
            '指定したサービス、ブロックから文字列を読み取り
            sStr = felicalib.read_string(sServicecode, sBlock)

            '------------------
            ' メッセージを表示
            '------------------
            sMsg = "IDm=[" & sIDm & "]" & vbNewLine & _
                   "sStr=[" & sStr & "]"
            Debug.Print(sMsg)
            MessageBox.Show(sMsg, Me.Text)
            My.Computer.FileSystem.WriteAllText("sStr.txt", sIDm & "," & sStr & vbNewLine, vbTrue)

        Else
            '--------------------------
            ' ポーリングに失敗した場合
            '--------------------------
            MessageBox.Show("FeliCa がセットされていません。", Me.Text)
        End If

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

    '======================
    ' 書き込みボタン・クリック処理
    '======================
    Private Sub btnWrite_Click(sender As Object, e As EventArgs) Handles btnWrite.Click
        '----------
        ' 変数定義
        '----------
        Dim felicalib As New CFelicaLib
        Dim sMsg As String
        Dim sResult As Integer

        Dim sServicecode As Integer = Convert.ToInt32(tbServce.Text, 16)
        Dim sBlock As Integer = Convert.ToInt32(tbBlock.Text, 16)

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

        '----------------------------
        ' ポーリング(FeliCa読み取り)
        '----------------------------
        If felicalib.Polling() Then
            '-----------------
            ' データの書き込み
            '-----------------
            sResult = felicalib.write_string(sServicecode, sBlock, tbString.Text)

            '------------------
            ' メッセージを表示
            '------------------
            If sResult = 0 Then
                sMsg = "書き込み成功"
            Else
                sMsg = "書き込み失敗" & sResult.ToString
            End If
            MessageBox.Show(sMsg, Me.Text)

        Else
            '--------------------------
            ' ポーリングに失敗した場合
            '--------------------------
            MessageBox.Show("FeliCa がセットされていません。", Me.Text)
        End If

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