Public Class frmRS232 Dim ConnectionOn As Boolean = 0 Dim Data() As Byte Dim ReadedBytes As Integer = 0 Const HexNumbers As String = "0123456789ABCDEF" Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load For Each PortName In System.IO.Ports.SerialPort.GetPortNames cmbPortNames.Items.Add(PortName) Next cmbDataBits.Text = 8 cmbStopBits.Text = 1 cmbParity.Text = "None" chkRTS.BackColor = Color.Red chkDTR.BackColor = Color.Red Me.MaximumSize = Me.Size Me.MinimumSize = Me.Size End Sub Private Sub btnSendByte_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSendByte.Click If txtDataEntry.Text = "" Then Exit Sub Try Select Case True Case radAsc.Checked SerialPort1.Write(txtDataEntry.Text) Case radDec.Checked Dim CharByte(0) As Byte : CharByte(0) = 0 CharByte(0) = Convert.ToByte(txtDataEntry.Text) SerialPort1.Write(CharByte, 0, 1) Case radHex.Checked Dim CharByte(0) As Byte : CharByte(0) = 0 If txtDataEntry.TextLength = 1 Then For i = 0 To 15 If txtDataEntry.Text.Chars(0) = HexNumbers.Chars(i) Then CharByte(0) = i End If Next ElseIf txtDataEntry.TextLength = 2 Then For i = 0 To 15 If txtDataEntry.Text.Chars(0) = HexNumbers.Chars(i) Then CharByte(0) += i * 16 End If If txtDataEntry.Text.Chars(1) = HexNumbers.Chars(i) Then CharByte(0) += i End If Next End If SerialPort1.Write(CharByte, 0, 1) Case radBin.Checked 'Binäre String-Eingabe in Byte umwandeln Dim CharByte(0) As Byte : CharByte(0) = 0 For i As Integer = 0 To txtDataEntry.TextLength - 1 CharByte(0) <<= 1 If txtDataEntry.Text.Chars(i) = "1" Then CharByte(0) += 1 'LSB setzen, OR 2^0 Next SerialPort1.Write(CharByte, 0, 1) End Select Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub btnConnection_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnConnection.Click ConnectionOn = Not ConnectionOn Try If ConnectionOn Then SerialPort1.Open() btnConnection.Text = "Disconnect" Else SerialPort1.Close() btnConnection.Text = "Connect" End If Catch ex As Exception MsgBox(ex.Message) ConnectionOn = Not ConnectionOn End Try End Sub Private Sub txtDataEntry_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtDataEntry.TextChanged If txtDataEntry.TextLength = 0 Then Exit Sub Dim CurrentChar As Char = txtDataEntry.Text.Chars(txtDataEntry.TextLength - 1) Select Case True Case radAsc.Checked Exit Sub Case radBin.Checked If CurrentChar <> "0" And CurrentChar <> "1" Then txtDataEntry.Text = "" ' txtByteEntry.Text = txtByteEntry.Text.Remove((txtByteEntry.TextLength - 1), 1) Case radDec.Checked Dim DecNumber As String = "0123456789" For i = 0 To 9 If CurrentChar = DecNumber.Chars(i) Then Exit Sub Next txtDataEntry.Text = "" Case radHex.Checked For i = 0 To 15 If CurrentChar = HexNumbers.Chars(i) Then Exit Sub Next txtDataEntry.Text = "" End Select End Sub Private Sub radAsc_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles radAsc.CheckedChanged, radBin.CheckedChanged, _ radDec.CheckedChanged, radHex.CheckedChanged txtDataEntry.Text = "" Select Case True Case radAsc.Checked txtDataEntry.MaxLength = 32767 Case radBin.Checked txtDataEntry.MaxLength = 8 Case radDec.Checked txtDataEntry.MaxLength = 3 Case radHex.Checked txtDataEntry.MaxLength = 2 End Select End Sub Private Sub cmbPortNames_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbPortNames.SelectedIndexChanged ConnectionOn = 1 'Verbindung Trennen btnConnection_Click(sender, e) SerialPort1.PortName = cmbPortNames.Text ConnectionOn = 0 'Verbindung Wiederherstellen btnConnection_Click(sender, e) End Sub Private Sub btnRefreshPortNames_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRefreshPortNames.Click cmbPortNames.Items.Clear() For Each PortName In System.IO.Ports.SerialPort.GetPortNames cmbPortNames.Items.Add(PortName) Next End Sub 'Private Sub cmbBaudRate_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbBaudRate.SelectedIndexChanged ' Try ' SerialPort1.BaudRate = cmbBaudRate.Text ' Catch ex As Exception ' MsgBox(ex.Message) ' End Try ' lbxReceiveData.Items.Add(SerialPort1.BaudRate) ' 'Dim OldValue As Integer = -1 ' 'Dim j As Boolean = 0 ' 'For i = 10 To 200000 Step 10 ' ' Try ' ' SerialPort1.BaudRate = i ' ' If Not (OldValue = i - 10) Then lbxPortNames.Items.Add(i) : j = 1 ' ' OldValue = i ' ' Catch ex As Exception ' ' If j Then lbxPortNames.Items.Add("bis" & OldValue) : j = 0 ' ' End Try ' 'Next 'End Sub Private Sub cmbBaudRate_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles cmbBaudRate.TextChanged Try SerialPort1.BaudRate = cmbBaudRate.Text Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub cmbDataBits_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbDataBits.SelectedIndexChanged SerialPort1.DataBits = cmbDataBits.Text End Sub Private Sub cmbStopBits_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbStopBits.SelectedIndexChanged Select Case cmbStopBits.Text Case "1" SerialPort1.StopBits = IO.Ports.StopBits.One Case "1.5" SerialPort1.StopBits = IO.Ports.StopBits.OnePointFive Case "2" SerialPort1.StopBits = IO.Ports.StopBits.Two End Select End Sub Private Sub cmbParity_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbParity.SelectedIndexChanged Select Case cmbParity.Text Case "None" SerialPort1.Parity = IO.Ports.Parity.None Case "Odd" SerialPort1.Parity = IO.Ports.Parity.Odd Case "Even" SerialPort1.Parity = IO.Ports.Parity.Even Case "Mark" SerialPort1.Parity = IO.Ports.Parity.Mark Case "Space" SerialPort1.Parity = IO.Ports.Parity.Space End Select End Sub Private Sub cmbWriteBufferSize_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles cmbWriteBufferSize.TextChanged Try If SerialPort1.IsOpen Then ConnectionOn = 1 'Verbindung Trennen btnConnection_Click(sender, e) SerialPort1.WriteBufferSize = cmbWriteBufferSize.Text ConnectionOn = 0 'Verbindung Wiederherstellen btnConnection_Click(sender, e) Else SerialPort1.WriteBufferSize = cmbWriteBufferSize.Text End If Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Sub chkRTS_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkRTS.CheckedChanged SerialPort1.RtsEnable = chkRTS.Checked If chkRTS.Checked Then chkRTS.BackColor = Color.Lime _ Else chkRTS.BackColor = Color.Red End Sub Private Sub chkDTR_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkDTR.CheckedChanged SerialPort1.DtrEnable = chkDTR.Checked If chkDTR.Checked Then chkDTR.BackColor = Color.Lime _ Else chkDTR.BackColor = Color.Red End Sub Private Sub SerialPort1_DataReceived(ByVal sender As System.Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived ReDim Data(SerialPort1.BytesToRead - 1) Try ReadedBytes = SerialPort1.Read(Data, 0, SerialPort1.BytesToRead) Me.Invoke(ListUpdateHandler) Catch ex As Exception MsgBox(ex.Message) End Try End Sub Private Delegate Sub DataReceivedDel() Private ListUpdateHandler As New DataReceivedDel(AddressOf ListUpdate) Private Sub ListUpdate() For Each Value In Data Select Case True Case radAsc.Checked txtReceivedData.Text &= Convert.ToChar(Value) Case radDec.Checked txtReceivedData.Text &= Value & " " Case radHex.Checked txtReceivedData.Text &= HexNumbers.Chars(Value \ 16) & _ HexNumbers.Chars(Value Mod 16) & " " Case radBin.Checked 'Ein Byte in binäre String-Ausgabe umwandeln Dim Maske As Byte = 128 For i = 0 To 7 txtReceivedData.Text &= (Value And Maske) / Maske Maske >>= 1 Next txtReceivedData.Text &= " " End Select Next End Sub Private Sub btnClearReceivedData_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClearReceivedData.Click txtReceivedData.Text = "" End Sub End Class