Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
'================
' 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.