|
C#,VB2005でRS-232Cのループテスト
|
VB2005 コード
Option Strict On
Imports System.IO.Ports
Imports System.Text
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
SetPortsName() 'ポート名を自動的に読み込み
End Sub
'DSR CTSのラベルの色を変えるデリゲート
Delegate Sub dlgChangeLabelColor(ByVal Lbl As Label, ByVal Col As Color)
'受信データをテキストボックスに書き込むデリゲート
Delegate Sub dlgsetText(ByVal Tbx As TextBox, ByVal text As String)
'エラーログを書き込む
Delegate Sub myDelegate(ByVal str As String)
'文字を変換するクラスを宣言
Dim encSjis As Encoding = Encoding.GetEncoding("shift-jis")
'Encoding encUTF8 = Encoding.GetEncoding("utf-8")
Dim encUni As Encoding = Encoding.GetEncoding("unicode")
'起動時にポート名をマシンから取得し、テキストに書き出す
Private Sub SetPortsName()
'ポート名を読み込みます
Dim ports() As String = SerialPort.GetPortNames()
'利用出来るポートが２つ有る場合と、１つの場合を分ける。
If ports.Length >= 2 Then
'ポートが２つ以上有る場合
textBoxPortName1.Text = ports(0) 'ポートをセット
textBoxPortName2.Text = ports(1) 'ポートをセット
groupBox1.Text = ports(0)
groupBox2.Text = ports(1)
ElseIf ports.Length = 1 Then
'ポートが一つの場合
textBoxPortName1.Text = ports(0)
serialPort1.PortName = ports(0)
groupBox1.Text = ports(0)
End If
End Sub
'ラベルのバックカラーを変更します
'デリゲートから呼ばれる
Private Sub changeLblColor(ByVal Lbl As Label, ByVal Col As Color)
Lbl.BackColor = Col
End Sub
'テキストボックスのテキストを変更しま
'デリゲートから呼ばれる
Private Sub setReadText(ByVal Tbx As TextBox, ByVal text As String)
Tbx.AppendText(text)
End Sub
'受信文字を保持するジェネリクス
'Byte配列で受信文字を読み込んだ後、Byte配列からListに１Byteづつ移し替え
'改行が現れたらSift-JisからUnicodeに変換して、デリゲートでメインのTextBox
'に書き込み、書き込み後Listをクリアして次の文字を読み込む。
Dim lstInt1 As List(Of Integer) = New List(Of Integer)()
Private Sub serialPort1_DataReceived(ByVal sender As Object, ByVal e As SerialDataReceivedEventArgs) Handles serialPort1.DataReceived
Dim dlgTxt As dlgsetText = New dlgsetText(AddressOf setReadText)
'受信文字
Dim byteRead(serialPort1.BytesToRead - 1) As Byte
'読み込み
serialPort1.Read(byteRead, 0, serialPort1.BytesToRead)
'読み込んだデータをlistで保持
For i As Integer = 0 To byteRead.Length - 1
'Listに追加
lstInt1.Add(byteRead(i))
'改行が出てきたらListをByte配列に移し替えてテキストボックスに書き込む
If lstInt1.Count >= 2 AndAlso lstInt1(lstInt1.Count - 2) = 13 _
AndAlso lstInt1(lstInt1.Count - 1) = 10 Then
'Byte配列に移し替える
Dim byteTmp(lstInt1.Count) As Byte
For j As Integer = 0 To lstInt1.Count - 1
byteTmp(j) = CByte(lstInt1(j))
Next
'shift-jis からunicodeに変換する
Dim byteUni() As Byte = Encoding.Convert(encSjis, encUni, byteTmp)
Dim strUni As String = encUni.GetString(byteUni)
'メインスレッドのテキストボックスに書き込む
Me.Invoke(New dlgsetText(AddressOf setReadText), New Object() {textBoxRead1, strUni})
'この書き方でも良い
'Dim dlgset As dlgsetText = New dlgsetText(AddressOf setReadText)
'Me.Invoke(dlgset, textBoxRead1, strUni)
'Listをクリアーする
lstInt1.Clear()
End If
Next
End Sub
Dim lstInt2 As List(Of Integer) = New List(Of Integer)
Private Sub serialPort2_DataReceived(ByVal sender As Object, ByVal e As SerialDataReceivedEventArgs) Handles serialPort2.DataReceived
Dim dT As dlgsetText = New dlgsetText(AddressOf setReadText)
'受信文字
Dim byteRead(serialPort2.BytesToRead - 1) As Byte
'読み込み
serialPort2.Read(byteRead, 0, serialPort2.BytesToRead)
'読み込んだデータをlistで保持
For i As Integer = 0 To byteRead.Length - 1
lstInt2.Add(byteRead(i))
If lstInt2.Count >= 2 AndAlso lstInt2(lstInt2.Count - 2) = 13 _
AndAlso lstInt2(lstInt2.Count - 1) = 10 Then
Dim byteTmp(lstInt2.Count) As Byte
For j As Integer = 0 To lstInt2.Count - 1
byteTmp(j) = CByte(lstInt2(j))
Next
Dim byteUni() As Byte = Encoding.Convert(encSjis, encUni, byteTmp)
Dim strUni As String = encUni.GetString(byteUni)
Me.Invoke(New dlgsetText(AddressOf setReadText), New Object() {textBoxRead2, strUni})
lstInt2.Clear()
End If
Next
End Sub
'セリアルポートのピンチェンジを検知して、ラベルの色を変える
Private Sub serialPort1_PinChanged(ByVal sender As Object, ByVal e As SerialPinChangedEventArgs) Handles serialPort1.PinChanged
Try
'デリゲートのインスタンスを作成
Dim aLc As dlgChangeLabelColor = New dlgChangeLabelColor(AddressOf changeLblColor)
If e.EventType = SerialPinChange.DsrChanged Then
'イベントがDsrChangedだったら
If serialPort1.DsrHolding = True Then
'DSRラベルのバックカラーを変える
Me.Invoke(aLc, lblDSR1, Color.LightGreen)
Else
Me.Invoke(aLc, lblDSR1, Color.Green)
End If
ElseIf e.EventType = SerialPinChange.CtsChanged Then
'イベントがCtsChangeだったら
If serialPort1.CtsHolding = True Then
'CTSラベルのバックカラーを変える
Me.Invoke(aLc, lblCTS1, Color.LightGreen)
Else
Me.Invoke(aLc, lblCTS1, Color.Green)
End If
End If
Catch
End Try
End Sub
Private Sub serialPort2_PinChanged(ByVal sender As Object, ByVal e As SerialPinChangedEventArgs) Handles serialPort2.PinChanged
Try
Dim aLc As dlgChangeLabelColor = New dlgChangeLabelColor(AddressOf changeLblColor)
If e.EventType = SerialPinChange.DsrChanged Then
If serialPort2.DsrHolding = True Then
Me.Invoke(aLc, lblDSR2, Color.LightGreen)
Else
Me.Invoke(aLc, lblDSR2, Color.Green)
End If
ElseIf e.EventType = SerialPinChange.CtsChanged Then
If serialPort2.CtsHolding = True Then
Me.Invoke(aLc, lblCTS2, Color.LightGreen)
Else
Me.Invoke(aLc, lblCTS2, Color.Green)
End If
End If
Catch
End Try
End Sub
'DtrEnableを設定
Private Sub chkDTR1_CheckedChanged(ByVal sender As Object, ByVal e As EventArgs) Handles chkDTR1.CheckedChanged
serialPort1.DtrEnable = chkDTR1.Checked
End Sub
'RtsEnableを設定
Private Sub chkRTS1_CheckedChanged(ByVal sender As Object, ByVal e As EventArgs) Handles chkRTS1.CheckedChanged
serialPort1.RtsEnable = chkRTS1.Checked
End Sub
Private Sub chkDTR2_CheckedChanged(ByVal sender As Object, ByVal e As EventArgs) Handles chkDTR2.CheckedChanged
serialPort2.DtrEnable = chkDTR2.Checked
End Sub
Private Sub chkRTS2_CheckedChanged(ByVal sender As Object, ByVal e As EventArgs) Handles chkRTS2.CheckedChanged
serialPort2.RtsEnable = chkRTS2.Checked
End Sub
'送信ボタン押下
Private Sub butSend1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles butSend1.Click
If serialPort1.IsOpen Then
Dim strSend As String = textBoxWrite1.Text
'改行が無かったら付け足す
If Not strSend.EndsWith(Chr(13) + Chr(10)) Then
strSend += Chr(13) + Chr(10)
''送信文字をShift-jisに変化してをByte配列に格納
Dim byteArry() As Byte = encSjis.GetBytes(strSend)
'送信
serialPort1.Write(byteArry, 0, byteArry.Length)
End If
End If
End Sub
'送信ボタン押下
Private Sub butSend2_Click(ByVal sender As Object, ByVal e As EventArgs) Handles butSend2.Click
If serialPort2.IsOpen Then
Dim strSend As String = textBoxWrite2.Text
'改行が無かったら付け足す
If Not strSend.EndsWith(Chr(13) + Chr(10)) Then
strSend += Chr(13) + Chr(10)
Dim byteArry() As Byte = encSjis.GetBytes(strSend)
'送信
serialPort2.Write(byteArry, 0, byteArry.Length)
'ログに書き込むテスト
'myDelegate dlg = new myDelegate(AddressOf setText)
'Me.Invoke(dlg, "送信" + textBoxWrite2.Text)
End If
End If
End Sub
'テキストボックスクリア
Private Sub butClsWrite1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles butClsWrite1.Click
textBoxWrite1.Clear()
End Sub
Private Sub butClsRead1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles butClsRead1.Click
textBoxRead1.Clear()
End Sub
Private Sub butClsWrite2_Click(ByVal sender As Object, ByVal e As EventArgs) Handles butClsWrite2.Click
textBoxWrite2.Clear()
End Sub
Private Sub butClsRead2_Click(ByVal sender As Object, ByVal e As EventArgs) Handles butClsRead2.Click
textBoxRead2.Clear()
End Sub
Private Sub butErrCls_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butErrCls.Click
textBoxErr.Clear()
End Sub
'ポートのオープン
Private Sub butOpen1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles butOpen1.Click
If serialPort1.IsOpen Then
serialPort1.Close()
groupBox1.Enabled = False
butOpen1.Text = "Open"
Else
serialPort1.PortName = textBoxPortName1.Text
serialPort1.Open()
groupBox1.Enabled = True
butOpen1.Text = "Close"
End If
End Sub
'ポートのオープン
Private Sub butOpen2_Click(ByVal sender As Object, ByVal e As EventArgs) Handles butOpen2.Click
If serialPort2.IsOpen Then
serialPort2.Close()
groupBox2.Enabled = False
butOpen2.Text = "Open"
Else
serialPort2.PortName = textBoxPortName2.Text
serialPort2.Open()
groupBox2.Enabled = True
butOpen2.Text = "Close"
End If
End Sub
'エラー又はログの書き込み用
Private Sub setText(ByVal str As String)
textBoxErr.AppendText(str + "\r\n")
End Sub
Private Sub serialPort1_ErrorReceived(ByVal sender As Object, ByVal e As SerialErrorReceivedEventArgs) Handles serialPort1.ErrorReceived
Dim md As myDelegate = New myDelegate(AddressOf setText)
Dim se As String = "エラーserialPort1:" + e.ToString()
Me.Invoke(md, se)
End Sub
Private Sub serialPort2_ErrorReceived(ByVal sender As Object, ByVal e As SerialErrorReceivedEventArgs) Handles serialPort2.ErrorReceived
Dim md As myDelegate = New myDelegate(AddressOf setText)
Dim se As String = "エラーserialPort2:" + e.ToString()
Me.Invoke(md, se)
End Sub
End Class
