VB.NET-TIPS などプログラミングについて

2018/08/13

クラスや構造体のデータをそのままファイルに登録し、再度読み込んで利用したい場合があります。この様な時に、クラスや構造体をそのままシリアライズ化し、バイナリ形式でファイルに書き込むことでできます。

今回は簡単な例として、クラスは3個のパブリックな要素を持っています。このクラスにデータを書込むときには、3個の変数にデータを設定してから、バイナリファイルへの書込関数と、バイナリファイルからの読込関数を呼出しています。但し、クラスの宣言には <Serializable()> が必要です。

バイナリファイルへの書込関数では、指定されたファイルを FileStream クラスで生成オープンして、 BinaryFormatter クラスでシリアライズ化を行って書き込みます。

バイナリファイルからの読込関数でも、同様に指定されたファイルを FileStream クラスでオープンして、 BinaryFormatter クラスでストリームからのデータを逆シリアライズ化を行って読み込みます。

尚、この例を示すために、3個のボタンを貼り、テストの実行を行います。

クラスや構造体のそのままのデータをシリアライズ化して保存する方法

Public Class frmSerialize

    ''' 
    ''' シリアライズ化を行うクラス(仮のクラス)
    ''' 
    <Serializable()> _
    Public Class DataClass
        Public intNo As Integer     '番号
        Public strData1 As String   'データ１
        Public strData2 As String   'データ２
    End Class

    ''' 
    ''' シリアライズ化関数
    ''' 
    ''' <param name="strFileName">書込みファイル名</param>
    ''' <param name="objPara">シリアライズ化するオブジェクト</param>
    ''' True:OK、False:NG
    Public Function WriteObj(ByVal strFileName As String, ByVal objPara As Object) As Boolean
        '指定されたファイルをFileStreamクラスで生成オープン
        Dim fs As New System.IO.FileStream(strFileName, System.IO.FileMode.Create)
        'BinaryFormatterクラス(オブジェクトのバイナリ形式でシリアル化および逆シリアル化クラス)
        Dim bf As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
        Try
            'オブジェクトをバイナリ形式でシリアル化
            bf.Serialize(fs, objPara)
            Return True
        Catch ex As Runtime.Serialization.SerializationException
            Return False
        Finally
            fs.Close()
        End Try
    End Function

    ''' 
    ''' デシリアライズ関数
    ''' 
    ''' <param name="strFileName">読込みファイル名</param>
    ''' <param name="objPara">結果を返すオブジェクト</param>
    ''' True:OK、False:NG
    Public Function ReadObj(ByVal strFileName As String, ByRef objPara As Object) As Boolean
        '指定されたファイルをFileStreamクラスでオープン
        Dim fs As New System.IO.FileStream(strFileName, System.IO.FileMode.Open)
        'BinaryFormatterクラス(オブジェクトのバイナリ形式でシリアル化および逆シリアル化クラス)
        Dim bf As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
        Try
            '指定されたオブジェクトを逆シリアル化し、指定オブジェクトに返す
            objPara = bf.Deserialize(fs)
            Return True
        Catch ex As Runtime.Serialization.SerializationException
            Return False
        Finally
            fs.Close()
        End Try
    End Function

    ' ***** これ以降は上記の関数等をテストするボタン処理 *****
    ' [シリアライズ化]ボタン処理
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        'クラスのインスタンス宣言
        Dim dc As New DataClass
        'クラスにデータ設定
        dc.intNo = TextBox1.Text
        dc.strData1 = TextBox2.Text
        dc.strData2 = TextBox3.Text
        'シリアライズ化(ファイルはデフォルトの位置)
        Dim blnRet As Boolean = WriteObj("DataFile.dat", dc)
    End Sub

    ' [逆シリアライズ化]ボタン処理
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim obj As Object = Nothing
        Dim blnRet As Boolean = ReadObj("DataFile.dat", obj)
        If blnRet = True Then
            Dim dc As DataClass = DirectCast(obj, DataClass)
            TextBox1.Text = dc.intNo
            TextBox2.Text = dc.strData1
            TextBox3.Text = dc.strData2
        End If
    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        TextBox1.Text = ""
        TextBox2.Text = ""
        TextBox3.Text = ""
    End Sub
End Class

結果これを実行すると以下の様になります。

SerialPortコントロールの使い方その２(通信用クラス)

Imports System.IO.Ports

''' -----------------------------------------------------------------------
''' 
''' シリアル通信クラス
''' 
''' -----------------------------------------------------------------------
Public Class ClsSerial

    ''' 
    ''' シリアルポートクラス
    ''' 
    ''' 
    Private SerialPort As SerialPort

    ''' 
    ''' 読込データ格納先
    ''' 
    ''' データ受信イベントで蓄えられる
    Private RxBuf() As Byte

    ''' 
    ''' コマンド応答受信フラグ
    ''' 
    ''' 
    ''' コマンドを送信した後での応答を受信したフラグ。送受信文字列のターミネータ[CR]（0x0d）を発見したとにオンする
    ''' 
    Private fRxResponse As Boolean = False

    ''' 
    ''' 送受信文字列のターミネータ（0x0d）
    ''' 
    Private Const CMD_TERM As Byte = &HD


    ''' -----------------------------------------------------------------------
    ''' 
    ''' コンストラクタ
    ''' 
    ''' <param name="SerialPort">シリアルポートコントロール</param>
    ''' -----------------------------------------------------------------------
    Sub New(ByVal SerialPort As SerialPort)
        'シリアルポートの退避
        Me.SerialPort = SerialPort
        '受信イベントのハンドラ設定
        AddHandler Me.SerialPort.DataReceived, AddressOf DataReceivedHandler
    End Sub

    ''' -----------------------------------------------------------------------
    ''' 
    ''' ポートオープン
    ''' 
    ''' True:正常終了, False:エラー
    ''' -----------------------------------------------------------------------
    Function Open() As Boolean
        '戻り値初期化
        Open = False
        Try
            'ポートチェック
            If Me.SerialPort.IsOpen = False Then
                '未オープンならば、オープンする

                'ポート設定(ここは通信相手に合わせる)
                Me.SerialPort.PortName = "COM7"
                Me.SerialPort.BaudRate = 9600
                Me.SerialPort.DataBits = 8
                Me.SerialPort.Parity = Parity.None
                Me.SerialPort.StopBits = StopBits.One
                'オープン
                Me.SerialPort.Open()
            End If
            '結果を返す
            Open = Me.SerialPort.IsOpen

        Catch ex As Exception
            'エラー処理
        End Try
    End Function

    ''' -----------------------------------------------------------------------
    ''' 
    ''' ポートクローズ
    ''' 
    ''' True:正常終了, False:エラー
    ''' -----------------------------------------------------------------------
    Function Close() As Boolean
        '戻り値初期化
        Close = False
        Try
            'ポートチェック
            If Me.SerialPort.IsOpen = True Then
                'オープン済みならば、クローズする
                Me.SerialPort.Close()
            End If
            '結果を返す
            Close = Not (Me.SerialPort.IsOpen)

        Catch ex As Exception
            'エラー処理
        End Try
    End Function

    ''' -----------------------------------------------------------------------
    ''' 
    ''' データ受信ハンドラ
    ''' 
    ''' -----------------------------------------------------------------------
    Private Sub DataReceivedHandler(sender As Object, e As SerialDataReceivedEventArgs)
        Try
            Dim SP As SerialPort = CType(sender, SerialPort)

            'バッファのバイト数チェック
            Dim DataLen As Integer = SP.BytesToRead
            If DataLen = 0 Then
                Exit Sub
            End If

            'データ長チェック
            If DataLen > 4096 Then
                DataLen = 4096
            End If

            '読込バッファの確保
            Dim Buf(DataLen) As Byte
            '読込
            SP.Read(Buf, 0, DataLen)
            '
            If RxBuf Is Nothing Then
                '格納バッファの領域確保
                RxBuf = Array.CreateInstance(GetType(Byte), DataLen)
                'コピー
                Array.Copy(Buf, RxBuf, DataLen)
            Else
                '後ろに追加する
                Dim Length As Integer = RxBuf.Length
                ReDim Preserve RxBuf(Length + DataLen - 1)
                Buf.CopyTo(RxBuf, Length)
            End If

            '格納先の最後の文字が「CR」(0x0d)か確認する
            If RxBuf(UBound(RxBuf)) = CMD_TERM Then
                'コマンド応答受信フラグON
                Me.fRxResponse = True
            End If

        Catch ex As Exception
            'エラー処理
        End Try
    End Sub

    ''' -----------------------------------------------------------------------
    ''' 
    ''' コマンド送信・レスポンス受信処理
    ''' 
    ''' <param name="strCmd">コマンド文字列</param>
    ''' <param name="strRsv">レスポンス文字列</param>
    ''' 応答受信結果(True:OK, False:NG)
    ''' -----------------------------------------------------------------------
    Public Function SendCmdGetRsv(ByVal strCmd As String, ByRef strRsv As String) As Boolean
        '戻り値初期化
        SendCmdGetRsv = False
        Try
            'コマンド送信
            If Me.SendData(strCmd) = False Then
                Return False
            End If

            'コマンド受信
            Dim strRX As String = ""
            If Me.ReceiveData(strRX) = False Then
                Return False
            End If
            strRsv = strRX

            '正常を返す
            Return True

        Catch ex As Exception
            'エラー処理
        End Try
    End Function

    ''' -----------------------------------------------------------------------
    ''' 
    ''' コマンド送信
    ''' 
    ''' <param name="strSend">送信文字列</param>
    ''' 送信結果(True:OK, False:NG)
    ''' -----------------------------------------------------------------------
    Private Function SendData(ByVal strSend As String) As Boolean
        '戻り値初期化
        SendData = False
        Try
            'ポートオープンチェック
            If Me.SerialPort.IsOpen = False Then
                Return False
            End If

            'Shift JISとしてバイト型配列に変換
            Dim bytesData As Byte()
            bytesData = System.Text.Encoding.GetEncoding(932).GetBytes(strSend)

            'CRの1バイト分領域拡張
            Dim nIdx As Integer = UBound(bytesData)
            ReDim Preserve bytesData(nIdx + 1)
            bytesData(nIdx + 1) = CMD_TERM

            'コマンド応答受信フラグOFF
            Me.fRxResponse = False

            'コマンド送信
            Me.RxBuf = Nothing  '受信バッファのクリア
            Me.SerialPort.Write(bytesData, 0, bytesData.Length)
            '正常
            Return True

        Catch ex As Exception
            'エラー処理
        End Try
    End Function

    ''' -----------------------------------------------------------------------
    ''' 
    ''' レスポンス受信処理
    ''' 
    ''' <param name="RcvRes">受信レスポンス</param>
    ''' 受信結果(True:OK, False:NG)
    ''' -----------------------------------------------------------------------
    Private Function ReceiveData(ByRef RcvRes As String) As Boolean
        '戻り値初期化
        ReceiveData = False
        Try
            'リトライ件数
            Dim nRetry As Integer = 50  '50×100msec＝5sec

            While nRetry > 0
                System.Threading.Thread.Sleep(100)
                Application.DoEvents()
                If Me.fRxResponse = True Then
                    '受信フラグONの場合、ループを抜ける
                    Exit While
                End If
                'リトライカウンタ--
                nRetry -= 1
            End While

            '-----
            'タイムアウトチェック
            '-----
            If nRetry = 0 Then
                'タイムアウトエラー
                Return False
            End If

            '受信バイトを文字列変換
            Dim strRx As String = System.Text.Encoding.GetEncoding(932).GetString(Me.RxBuf)
            strRx = strRx.Substring(0, strRx.Length - 1)    '最後の「CR」は省く

            '-----
            '受信データ処理
            '-----
            '以下の処理などが在れば記述
            '・BCC等のチェック処理
            '・レスポンスチェック処理(送信側のエラーメッセージ等)
            '-----

            '受信レスポンスを返す
            RcvRes = strRx

            '結果正常
            Return True

        Catch ex As Exception
            'エラー処理
        End Try
    End Function

End Class

突っ込みどころが満載なクラスですが、簡単なコマンドを送信し、レスポンスを受信するぐらいであれば使用できると思います。
尚、受信イベントでの処理で、受信バッファを4096に限定していますので、この辺りを改良してみて下さい。
また、レスポンスの受信データをそのまま返していますが、エラー処理などは通信先の装置に合わせて下さい。

このクラスを使用した例を以下のソースに示します。

SerialPortコントロールの使い方その２(通信用クラスの使用例)

Public Class frmSerial2

    'シリアル通信クラス
    Private mclsSerial As ClsSerial

    ''' 
    ''' フォームクローズイベント
    ''' 
    Private Sub frmSerial2_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
        'シリアル通信のクローズ
        mclsSerial.Close()
    End Sub

    ''' 
    ''' フォームロードイベント
    ''' 
    Private Sub frmSerial2_Load(sender As Object, e As EventArgs) Handles Me.Load
        'シリアル通信クラスの生成
        mclsSerial = New ClsSerial(Me.SerialPort1)
        'シリアル通信のオープン
        If mclsSerial.Open() = False Then
            'オープンエラー(必要があれば処理する)
        End If
    End Sub

    ''' 
    ''' [コマンド送信]クリックイベント
    ''' 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        'レスポンス表示クリア
        Me.TextBox2.Text = ""
        'コマンド取得
        Dim strCmd As String = Me.TextBox1.Text.Trim
        If strCmd <> "" Then
            Dim strRsv As String = ""
            If Me.mclsSerial.SendCmdGetRsv(strCmd, strRsv) = True Then
                '正常受信、レスポンス表示
                Me.TextBox2.Text = strRsv
            Else
                'エラー
                Me.TextBox2.Text = "エラー発生"
            End If
        End If
    End Sub

End Class

このフォームは、送信用の文字列を入力する TextBox と、受信結果を表示する TextBox を画面に張り付け、通信の処理をさせるボタンを張り付けてあります。

実行の様子を下図に示します。

送信する文字列を 送信コマンド: TextBox に入力し、「コマンド送信」ボタンを押下します。
「RS232Cテストツール」側でコマンドの受信を確認して、「TEXT送信」ボタンを押下しますと、 受信レスポンス: TextBox にデータが表示されます。
（尚、通信相手のシミュレーションとしてフリーソフトの「RS232Cテストツール」を使用しています。）

尚、通信相手用の仮想シリアルポートとしてcom0com というドライバを使用し、 2個のシリアルポートを作成し、ループバックで接続しています。今回のプログラムをテストするためには外部装置か、もう一台別のPCが必要になりますが、そんなことをしなくてもデバッグができるソフト(ドライバ)が在ります。

com0com というドライバで、PC上に仮想シリアルポートを2個作成し、その2個をループバックできる様に仮想的に接続できるという優れものです。以下のリンク先でソフトをダウンロードしてインストールしてみて下さい。（尚、もう一台のPCなどがあれば必要ありませんが）

⇒「com0com ドライバ」

COM8側を通信相手側（外部装置）とするのですが、通信テスト用に以下のフリーソフトを使いました。
「のん」さんといわれる方が作成された「RS232Cテストツール」です。
以下のサイトにアクセスすれば、ダウンロードできます。

⇒「RS232Cテストツール」

USB ⇒ RS232C 変換ケーブル

シリアル通信に関連してですが、最近のPC、特にノートPCの場合ではRS232Cのコネクタがついていることは殆んどありません。
そのため、以下の様なUSBを使ったRS232Cの変換ケーブルが使えそうです。
⇒iBUFFALO USBシリアルケーブル(USBtypeA to D-sub9ピン)1.0m ブラックスケルトン BSUSRC0610BS
⇒サンワサプライ USB-RS232Cコンバータ USB-CVRS9
⇒Plugable USB‐9ピンRS232シリアルアダプター (Prolific社製 PL2303HX Rev Dチップセット採用)

プロパティを持つ子フォームのクラス

''' 
''' プロパティを持つ子フォーム
''' 
Public Class frmProperty

    'チェック状態退避値
    Private mblnChkStatus As Boolean = False

    ''' 
    ''' チェック状態プロパティ
    ''' 
    ''' チェック状態の設定値
    ''' チェック状態を返す
    Public Property ChkStatus As Boolean
        Set(value As Boolean)
            mblnChkStatus = value   '退避値に設定
        End Set
        Get
            Return mblnChkStatus    '退避値を返す
        End Get
    End Property

    ''' 
    ''' ボタンクリックイベント
    ''' 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        'チェックボックスの状態を退避
        Me.mblnChkStatus = Me.CheckBox1.Checked
        '自分を閉じる
        Me.Close()
    End Sub

    ''' 
    ''' フォームロードイベント
    ''' 
    Private Sub fomProperty_Load(sender As Object, e As EventArgs) Handles Me.Load
        'チェックボックスの初期状態設定
        Me.CheckBox1.Checked = Me.mblnChkStatus
    End Sub

End Class

この子フォームを呼出す親フォームの処理が以下の様になります。

子フォームを呼出す親フォームの処理

''' 
''' 子フォームを呼出す親フォーム
''' 
Public Class frmPropMain

    ''' 
    ''' ボタンクリックイベント
    ''' 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        'プロパティテストウインドウ生成
        Dim frmProp As New frmProperty
        'プロパティに自分のチェックボックスの値を設定
        frmProp.ChkStatus = Me.CheckBox1.Checked
        'ウインドウ表示
        frmProp.ShowDialog()
        'プロパティ値を自分のチェックボックスの値に設定
        Me.CheckBox1.Checked = frmProp.ChkStatus
        'プロパティテストウインドウ廃棄
        frmProp.Dispose()
        frmProp = Nothing
    End Sub

End Class

この例では子フォームを生成した後で、子フォームのプロパティを設定しています。二回に分けて処理をしますので少し面倒ですね。
この面倒さを解消するには、子フォームクラスの生成に引数として渡せればできるのです。

実際にどの様にするのかを、上記のソースを土台にして変えていきます。尚、今回の例ではフォームクラスの名前を frmConstructor と変えています。

ソースは上記の frmProperty を全てコピーしてきて、その後でクラスの先頭辺りで Sub New とキー入力します。そうすると、以下の様な感じで Sub New() の関数が自動で表示されます。

コンストラクタを明示する子フォームのクラス

''' 
''' コンストラクタを明示する子フォーム
''' 
Public Class frmConstructor

    Sub New()

        ' この呼び出しはデザイナーで必要です。
        InitializeComponent()

        ' InitializeComponent() 呼び出しの後で初期化を追加します。

    End Sub

    'チェック状態退避値
    Private mblnChkStatus As Boolean = False

    ''' 
    ''' チェック状態プロパティ
    ''' 
    ''' チェック状態の設定値
    ''' チェック状態を返す
    Public Property ChkStatus As Boolean
        Set(value As Boolean)
            mblnChkStatus = value   '退避値に設定
        End Set
        Get
            Return mblnChkStatus    '退避値を返す
        End Get
    End Property

    ''' 
    ''' ボタンクリックイベント
    ''' 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        'チェックボックスの状態を退避
        Me.mblnChkStatus = Me.CheckBox1.Checked
        '自分を閉じる
        Me.Close()
    End Sub

    ''' 
    ''' フォームロードイベント
    ''' 
    Private Sub fomProperty_Load(sender As Object, e As EventArgs) Handles Me.Load
        'チェックボックスの初期状態設定
        Me.CheckBox1.Checked = Me.mblnChkStatus
    End Sub

End Class

この後で Sub New() に引数を宣言し、フォーム生成時にプロパティが設定できる様に以下の様にソースを変更します。

コンストラクタ（引数設定）を明示する子フォームのクラス

''' 
''' コンストラクタを明示する子フォーム
''' 
Public Class frmConstructor

    Sub New(ByVal blnChk As Boolean)

        ' この呼び出しはデザイナーで必要です。
        InitializeComponent()

        ' InitializeComponent() 呼び出しの後で初期化を追加します。

        'プロパティを設定する
        Me.ChkStatus = blnChk
    End Sub

    'チェック状態退避値
    Private mblnChkStatus As Boolean = False

    ''' 
    ''' チェック状態プロパティ
    ''' 
    ''' チェック状態の設定値
    ''' チェック状態を返す
    Public Property ChkStatus As Boolean
        Set(value As Boolean)
            mblnChkStatus = value   '退避値に設定
        End Set
        Get
            Return mblnChkStatus    '退避値を返す
        End Get
    End Property

    ''' 
    ''' ボタンクリックイベント
    ''' 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        'チェックボックスの状態を退避
        Me.mblnChkStatus = Me.CheckBox1.Checked
        '自分を閉じる
        Me.Close()
    End Sub

    ''' 
    ''' フォームロードイベント
    ''' 
    Private Sub fomProperty_Load(sender As Object, e As EventArgs) Handles Me.Load
        'チェックボックスの初期状態設定
        Me.CheckBox1.Checked = Me.mblnChkStatus
    End Sub

End Class

子フォームの生成時に引数を設定し処理する例として以下のソースに示します。

引数を持って子フォームを呼出す親フォームの処理

''' 
''' 引数を持って子フォームを呼出す親フォーム
''' 
Public Class frmConstructorMain

    ''' 
    ''' ボタンクリックイベント
    ''' 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        'プロパティテストウインドウ生成(自分のチェックボックスの値を引数)
        Dim frmConst As New frmConstructor(Me.CheckBox1.Checked)
        'ウインドウ表示
        frmConst.ShowDialog()
        'プロパティ値を自分のチェックボックスの値に設定
        Me.CheckBox1.Checked = frmConst.ChkStatus
        'プロパティテストウインドウ廃棄
        frmConst.Dispose()
        frmConst = Nothing
    End Sub

End Class

もし、引数在りでも無しでも両方の子フォームのコンストラクタを持ちたい場合には、以下の様に引数無しの Sub New() をもう1個宣言すればできます。

この方法は オーバーロード と言われるもので、引数や戻り値が異なるが名前が同じの関数を複数定義する方法です。
（この場合は Sub の宣言ですが、 Function の場合でも同じ様にできます。）

コンストラクタ（引数設定）を明示する子フォームのクラス

''' 
''' コンストラクタを明示する子フォーム
''' 
Public Class frmConstructor

    Sub New(ByVal blnChk As Boolean)

        ' この呼び出しはデザイナーで必要です。
        InitializeComponent()

        ' InitializeComponent() 呼び出しの後で初期化を追加します。

        'プロパティを設定する
        Me.ChkStatus = blnChk
    End Sub

    Sub New()

        ' この呼び出しはデザイナーで必要です。
        InitializeComponent()

    End Sub

    '以下のソースは省略.....

End Class