Click here to Skip to main content
15,896,606 members
Articles / Programming Languages / Visual Basic

Asynchronous Serial Port Communication

Rate me:
Please Sign up or sign in to vote.
2.20/5 (16 votes)
21 Apr 2008CPOL2 min read 68.3K   30   32  
How to communicate to a serial port asynchronously
Public Class Hopper

#Region " Dispose "

    Implements IDisposable

    Public Overloads Sub Dispose() Implements IDisposable.Dispose
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub

    Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            ' Free other state (managed objects)
            Port.Close()
            Port.Dispose()
        End If
        ' Free your own state (unmanaged objects).
        ' Set large fields to null.
    End Sub

    Protected Overrides Sub Finalize()
        'Simply call Dispose(False).
        Dispose(False)
    End Sub

#End Region

#Region " Initilization of Class"

    Public Sub New(ByVal PortName As String, _
                    Optional ByVal BaudRate As Integer = 9600, _
                    Optional ByVal ParityBits As IO.Ports.Parity = IO.Ports.Parity.None, _
                    Optional ByVal DataBits As Integer = 8, _
                    Optional ByVal StopBits As IO.Ports.StopBits = IO.Ports.StopBits.One)
        Try
            Port = My.Computer.Ports.OpenSerialPort(PortName, BaudRate, ParityBits, DataBits, StopBits)
            Port.Handshake = IO.Ports.Handshake.None
            Port.RtsEnable = True
            Port.DtrEnable = True
            Port.DiscardNull = False
            If Port.IsOpen = True Then
                Port.Close()
                Port.WriteBufferSize = 1024
                Port.ReadBufferSize = 1024
                Port.ReceivedBytesThreshold = 1
                Port.ReadTimeout = -1
                Port.WriteTimeout = -1
                Port.ParityReplace = 63
                Port.Open()
            End If
            BaudRates = BaudRate
            ParityBit = ParityBits
            DataBit = DataBits
            StopBit = StopBits
        Catch ex As Exception
            MsgBox("Port Connection Error : - " + ex.Message, MsgBoxStyle.Critical, "Port Connection")
        End Try

        '' vairable initilaztion
        BufferSize = 0
        TotalByteLastRec = 0
        LastOffset = 0
    End Sub

#End Region

#Region " Variables"

#Region " Serail Port Declaration"

    Private WithEvents Port As IO.Ports.SerialPort
    Private BaudRates As Integer
    Private DataBit As Integer
    Private ParityBit As IO.Ports.Parity
    Private StopBit As IO.Ports.StopBits

#End Region

#Region " Buffers"

#Region " Enable Hopper Buffer"
    '' create a buffer for the transmission and recieving the bytes
    Dim Enable_Hoper_TX() As Byte = {&H3, &H1, &H1, &HA4, &HA5, &HB2} '' Size 5
    Dim Enable_Hoper_RX() As Byte = {&H1, &H0, &H3, &H0, &HFC}

#End Region

#Region " Cipher Key Buffer"
    '' create a buffer for the transmission and recieving the key
    Private Rec_CipherKey_TX(4) As Byte
    Private Rec_CipherKey_RX(12) As Byte '' request for the cipher key

#End Region

#Region " Dispense Hopper Conins Buffer"
    ''create a buffer for the transmission for the dipense of coins from hopper
    Private Dispense_HopperCoin_TX(13) As Byte
    Private Dispense_HopperCoin_RX(5) As Byte '' request for the Dispense_HopperCoin

#End Region

#Region " Hopper Status Buffer "
    'create a buffer for status of the hopper
    Private Hopper_Status_TX() As Byte = {&H3, &H0, &H1, &HA6, &H56}
    Private Hopper_Status_RX(8) As Byte '' to check the status
  
#End Region

#Region " Temporary Buffer"

    Dim InBuffer(100) As Byte

#End Region

#End Region

#Region " Other"

    Private HexaCoins As Byte
    Private BufferSize As Integer '' to keep track the bytetoread
    Private LastOffset As Integer '' to keep track the last no of bytes recived
    Private TotalByteLastRec As Integer '' to keep track the total bytes recived before next transmission
    Private Const _appStr As String = "&H"  '' to append hexa 
    Private ConisDispense As Integer
    Private ConisLeft As Integer
    Private Message As String
    Private NoofCoins As Integer
    Private Per_Completed As Integer
    '
    Dim Key_Org(7), Key_temp(7), temp_k As Byte
#End Region

#Region " Last Action Enumeration"

    Public Enum LastAction
        Enable_Hopper
        Request_key
        Disable_hopper
        Status
        None
    End Enum

    Private Action As New LastAction

#End Region

#End Region

#Region " Properties"

    Public ReadOnly Property CurrentBufferSize() As Integer
        Get
            Return BufferSize
        End Get
    End Property

    Public ReadOnly Property TotalBytesReceived() As Integer
        Get
            Return TotalByteLastRec
        End Get
    End Property

    Public ReadOnly Property LastActionTaken() As LastAction
        Get
            Return Action
        End Get
    End Property

    Public ReadOnly Property NoofCoinsLeft() As Integer
        Get
            Return ConisLeft
        End Get
    End Property

    Public ReadOnly Property NoofCoinsDispensed() As Integer
        Get
            Return ConisDispense
        End Get
    End Property

    Public ReadOnly Property PortMessage() As String
        Get
            Return Message
        End Get
    End Property

    Public ReadOnly Property PercentageCompleted() As Integer
        Get
            Return Per_Completed
        End Get
    End Property

    Public ReadOnly Property BaudRate() As Integer
        Get
            Return BaudRates
        End Get
    End Property

    Public ReadOnly Property DataBits() As Integer
        Get
            Return DataBit
        End Get
    End Property

    Public ReadOnly Property StopBits() As IO.Ports.StopBits
        Get
            Return StopBit
        End Get
    End Property

    Public ReadOnly Property ParityBits() As IO.Ports.Parity
        Get
            Return ParityBit
        End Get
    End Property

#End Region

#Region " Conversion Function"

    Private Function Make_BitBin(ByVal bin As String, ByVal bitlen As Integer) As String
        Dim tempstring As String = String.Empty
        If Len(bin) < 8 Then
            Dim insert As Integer = bitlen - Len(bin)
            For i As Integer = 0 To insert
                tempstring = tempstring + "0"
            Next
        End If
        Return tempstring + bin
    End Function

    Private Function DecToBin(ByVal DeciValue As Long, Optional ByVal NoOfBits As Integer = 8) As String
        Dim i As Integer
        'make sure there are enough bits to contain the number  
        Do While DeciValue > (2 ^ NoOfBits) - 1
            NoOfBits = NoOfBits + 8
        Loop
        DecToBin = vbNullString
        'build the string  
        For i = 0 To (NoOfBits - 1)
            DecToBin = CStr((DeciValue And 2 ^ i) / 2 ^ i) & DecToBin
        Next i
    End Function

    Private Function Bin_To_Dec(ByVal Bin As String) 'function to convert a binary number to decimal
        Dim dec As Double = Nothing
        Dim length As Integer = Len(Bin)
        Dim temp As Integer = Nothing
        Dim x As Integer = Nothing
        For x = 1 To length
            temp = Val(Mid(Bin, length, 1))
            length = length - 1
            If temp <> "0" Then
                dec += (2 ^ (x - 1))
            End If
        Next

        Return dec
    End Function

#End Region

#Region " Send & Recive Data From Port"

    ''' <summary>
    ''' Is to call the Hopper to dispense the coins from the machine
    ''' </summary>
    ''' <param name="Coins">Coins Parameter is in integer value. Maximum is 255</param>
    ''' <remarks></remarks>
    Public Sub DispenseCoins(ByVal Coins As Integer)
        Try
            NoofCoins = Coins
            HexaCoins = Convert.ToByte(Convert.ToString(Hex(CLng(Coins))), 16)
            Message = "Enabling the Hopper"
            SendByte(Enable_Hoper_TX)
        Catch ex As Exception
            Message = "Error in Enabling of the Hopper"
        End Try
    End Sub

    Private Sub SendByte(ByVal byts() As Byte)
        If Port.IsOpen = False Then
            Port.Open()
        End If
        Port.Write(byts, 0, byts.Length)
    End Sub

    Private Sub ReceivedBytes(ByVal sender As Object, ByVal e As IO.Ports.SerialDataReceivedEventArgs) Handles Port.DataReceived
        BufferSize = Port.BytesToRead
        TotalByteLastRec = TotalByteLastRec + BufferSize
        If BufferSize > 0 Then
            Port.Read(InBuffer, LastOffset, BufferSize)
            LastOffset = BufferSize
        End If
        '   port.DiscardInBuffer()
        If Port.BytesToRead = 0 Then
            LastOffset = 0
            BufferSize = 0
            Port.DiscardInBuffer()
            Select Case Action
                Case LastAction.Enable_Hopper

                Case LastAction.Disable_hopper

                Case LastAction.Request_key

                Case LastAction.Status

            End Select
        End If
    End Sub
#End Region

#Region " Port Error Event"

    Private Sub Port_Error(ByVal sender As Object, ByVal e As IO.Ports.SerialErrorReceivedEventArgs) Handles Port.ErrorReceived
        MsgBox("error")
    End Sub

#End Region

#Region " Create Transmission Key"

#Region "Encryption Steps"

    Private Sub Hopper_Encryption_Steps()

        '' step one
        temp_k = Op1_BitShuffle(HexaCoins)

        ''step two
        Key_temp = XOR_All(temp_k)


        '' strp three
        temp_k = Key_temp(5) '' point to the index 5
        Key_temp(5) = Xor_Key_Value(temp_k, &HA5)

        '' Step Four
        Key_temp(0) = Xor_Key_Value(Key_temp(0), &H84)

        '' Step Five
        Op2_BarrelRotation(5)

        ''STEP SIX
        temp_k = Key_temp(3)
        Key_temp(3) = Xor_Key_Value(temp_k, &H2)

        '' STEP SEVEN
        temp_k = Key_temp(2)
        Key_temp(2) = Xor_Key_Value(temp_k, &H90)

        ''STEP 8
        temp_k = Key_temp(3)
        Key_temp(3) = Op1_BitShuffle(temp_k)

        '' STEP 9
        Op2_BarrelRotation(2)

        ''STEP 10
        temp_k = Key_temp(7)
        Key_temp(7) = Complements(temp_k)

        ''STEP 11
        temp_k = Key_temp(0)
        Key_temp(0) = Complements(temp_k)

        ''STEP 12
        temp_k = Key_temp(5)
        Key_temp(5) = Complements(temp_k)

        ''STEP 13
        Swaps(1, 7)

        ''STEP 14
        Swaps(2, 0)

        '' STEP 15
        Swaps(0, 7)

        ''STEP 16
        Swaps(3, 5)

        ''STEP 17
        Swaps(1, 0)

        ''    STEP 18
        Swaps(4, 5)

        ''STEP 19
        temp_k = Key_temp(1)
        Key_temp(1) = Complements(temp_k)

        ''STEP 20
        temp_k = Key_temp(6)
        Key_temp(6) = Complements(temp_k)

        ''STEP 21
        Swaps(1, 7)

        ''STEP 22
        Swaps(2, 0)

        ''STEP 23
        Swaps(0, 7)

        ''STE[ 24
        Swaps(3, 5)

        'STEP 25
        Swaps(3, 7)

        ''STEP 26
        Swaps(1, 2)

        ''STEP 27
        temp_k = Key_temp(1)
        Key_temp(1) = Xor_Key_Value(temp_k, &HF2)

        ''STEP 28
        temp_k = Key_temp(3)
        Key_temp(3) = Xor_Key_Value(temp_k, &H2)

        'STEP 29
        temp_k = Key_temp(2)
        Key_temp(2) = Xor_Key_Value(temp_k, &H90)

        'STEP 30
        Op3_LongBarrelRotation(5)

        'step 31
        Swaps(3, 4)

        'step 32
        Swaps(6, 0)

        'step 33
        Swaps(1, 0)

        'step 34
        Swaps(4, 5)


        'step 35
        temp_k = Key_temp(6)
        Key_temp(6) = Xor_Key_Value(temp_k, &H33)

        'step 36
        temp_k = Key_temp(5)
        Key_temp(5) = Xor_Key_Value(temp_k, &HA5)

        'step 37
        temp_k = Key_temp(0)
        Key_temp(0) = Xor_Key_Value(temp_k, &H84)

        'step 38
        temp_k = Key_temp(0)
        Key_temp(0) = Complements(temp_k)

        'step 39
        temp_k = Key_temp(5)
        Key_temp(5) = Complements(temp_k)


        'step 40
        temp_k = Key_temp(1)
        Key_temp(1) = Complements(temp_k)

        ''STEP 41
        temp_k = Key_temp(6)
        Key_temp(6) = Complements(temp_k)


        'STEP 42
        temp_k = Key_temp(2)
        Key_temp(2) = Complements(temp_k)

        'STEP 43
        temp_k = Key_temp(3)
        Key_temp(3) = Complements(temp_k)

        'STEP 44
        Op3_LongBarrelRotation(6)

        ''STEP 45
        Op2_BarrelRotation(6)

        'STEP 46
        Op3_LongBarrelRotation(5)


        'STEP 47
        temp_k = Key_temp(7)
        Key_temp(7) = Complements(temp_k)

        'STEP 48
        temp_k = Key_temp(4)
        Key_temp(4) = Complements(temp_k)


        'STEP 49
        temp_k = Key_temp(0)
        Key_temp(0) = Complements(temp_k)

        'STEP 50
        temp_k = Key_temp(5)
        Key_temp(5) = Complements(temp_k)


        'STEP 51
        temp_k = Key_temp(2)
        Key_temp(2) = Complements(temp_k)


        'STEP 52
        temp_k = Key_temp(3)
        Key_temp(3) = Complements(temp_k)

        'STEP 53
        temp_k = Key_temp(3)
        Key_temp(3) = Op1_BitShuffle(temp_k)

        'STEP 54
        temp_k = Key_temp(2)
        Key_temp(2) = Op1_BitShuffle(temp_k)


        'STEP 55
        temp_k = Key_temp(7)
        Key_temp(7) = Op1_BitShuffle(temp_k)

        'STEP 56
        temp_k = Key_temp(6)
        Key_temp(6) = Op1_BitShuffle(temp_k)

        'STEP 57
        Op3_LongBarrelRotation(6)

        'STEP 58
        temp_k = Key_temp(3)
        Key_temp(3) = Op1_BitShuffle(temp_k)


        'STEP 59
        temp_k = Key_temp(5)
        Key_temp(5) = Op1_BitShuffle(temp_k)

        'STEP 60
        temp_k = Key_temp(0)
        Key_temp(0) = Op1_BitShuffle(temp_k)

        'STEP 61
        temp_k = Key_temp(6)
        Key_temp(6) = Op1_BitShuffle(temp_k)
    End Sub

#End Region

#Region " Op1 - BiShuffle"

    Private Function Op1_BitShuffle(ByVal inputvalue As Byte) As Byte
        Return ((inputvalue And &H55) * 2) + ((inputvalue And &HAA) / 2)
    End Function

#End Region

#Region " Op2 - Word Barrel Rotation Left"

    Private Sub Op2_BarrelRotation(ByVal Places As Integer)
        '   Dim B_21, B_22, B_31, B_32, B_41, B_42 As String
        Dim Word1, Word2, Word3, Word4 As String
        ''  capture the vaule of each key

        '' Convert The Word1 to BIN
        Word1 = Op2_BarrelRotation_2(DecToBin(CLng(Key_temp(1))), DecToBin(CLng(Key_temp(6))), Places)
        Key_temp(1) = Convert.ToByte(Mid(Word1, 1, 2), 16)
        Key_temp(6) = Convert.ToByte(Mid(Word1, 4, 2), 16)

        Word2 = Op2_BarrelRotation_2(DecToBin(CLng(Key_temp(4))), DecToBin(CLng(Key_temp(7))), Places)
        Key_temp(4) = Convert.ToByte(Mid(Word2, 1, 2), 16)
        Key_temp(7) = Convert.ToByte(Mid(Word2, 4, 2), 16)

        Word3 = Op2_BarrelRotation_2(DecToBin(CLng(Key_temp(0))), DecToBin(CLng(Key_temp(3))), Places)
        Key_temp(0) = Convert.ToByte(Mid(Word3, 1, 2), 16)
        Key_temp(3) = Convert.ToByte(Mid(Word3, 4, 2), 16)

        Word4 = Op2_BarrelRotation_2(DecToBin(CLng(Key_temp(5))), DecToBin(CLng(Key_temp(2))), Places)
        Key_temp(5) = Convert.ToByte(Mid(Word4, 1, 2), 16)
        Key_temp(2) = Convert.ToByte(Mid(Word4, 4, 2), 16)

    End Sub

    Private Function Op2_BarrelRotation_2(ByVal String1 As String, ByVal String2 As String, ByVal Places As Integer) As String
        Dim tempBINstring As String = Mid(String1, Places + 1) & String2 & Mid(String1, 1, Places)
        Return Convert.ToString(Hex(CLng(Bin_To_Dec(Mid(tempBINstring, 1, 4))))) + _
                    Convert.ToString(Hex(CLng(Bin_To_Dec(Mid(tempBINstring, 5, 4))))) + _
                    "?" + _
                    Convert.ToString(Hex(CLng(Bin_To_Dec(Mid(tempBINstring, 9, 4))))) + _
                    Convert.ToString(Hex(CLng(Bin_To_Dec(Mid(tempBINstring, 13, 4)))))

    End Function

#End Region

#Region " Op3 - Long Barrel Rotation Left"

    Private Sub Op3_LongBarrelRotation(ByVal places As Integer)
        Dim Tempstring As String = String.Empty
        Tempstring = Tempstring + IIf(Len(DecToBin(Key_temp(0))) = 8, DecToBin(Key_temp(0)), Make_BitBin(DecToBin(Key_temp(0)), 8))
        Tempstring = Tempstring + IIf(Len(DecToBin(Key_temp(1))) = 8, DecToBin(Key_temp(1)), Make_BitBin(DecToBin(Key_temp(1)), 8))
        Tempstring = Tempstring + IIf(Len(DecToBin(Key_temp(2))) = 8, DecToBin(Key_temp(2)), Make_BitBin(DecToBin(Key_temp(2)), 8))
        Tempstring = Tempstring + IIf(Len(DecToBin(Key_temp(3))) = 8, DecToBin(Key_temp(3)), Make_BitBin(DecToBin(Key_temp(3)), 8))
        Tempstring = Tempstring + IIf(Len(DecToBin(Key_temp(4))) = 8, DecToBin(Key_temp(4)), Make_BitBin(DecToBin(Key_temp(4)), 8))
        Tempstring = Tempstring + IIf(Len(DecToBin(Key_temp(5))) = 8, DecToBin(Key_temp(5)), Make_BitBin(DecToBin(Key_temp(5)), 8))
        Tempstring = Tempstring + IIf(Len(DecToBin(Key_temp(6))) = 8, DecToBin(Key_temp(6)), Make_BitBin(DecToBin(Key_temp(6)), 8))
        Tempstring = Tempstring + IIf(Len(DecToBin(Key_temp(7))) = 8, DecToBin(Key_temp(7)), Make_BitBin(DecToBin(Key_temp(7)), 8))

        Tempstring = Mid(Tempstring, places + 1) + Mid(Tempstring, 1, places)
        Tempstring = IIf(Len(Tempstring) < 64, Make_BitBin(Tempstring, 64), Tempstring)
        Dim Pos As Integer = 1
        For i As Integer = 0 To 7
            Dim _8bit As String = Convert.ToString(Hex(CLng(Bin_To_Dec(Mid(Tempstring, Pos, 8)))))
            Key_temp(i) = Convert.ToByte(_8bit, 16)
            Pos = Pos + 8
        Next
    End Sub

#End Region

#Region " XOR ALL"

    Private Function XOR_All(ByVal InputValue As Byte) As Byte()
        Dim TempKey(7) As Byte
        For i As Integer = 0 To 7
            TempKey(i) = Key_Org(i) Xor InputValue
        Next
        Return TempKey
    End Function

#End Region

#Region " XOR On Key with a Value "

    Private Function Xor_Key_Value(ByVal Temp_K As Byte, ByVal XORValue As Byte) As Byte
        Return Temp_K Xor XORValue
    End Function

#End Region

#Region " Complements"

    Private Function Complements(ByVal Temp_K As Byte) As Byte
        Return 255 - Temp_K
    End Function

#End Region

#Region " SWAPS "

    Private Sub Swaps(ByVal KeyIndex1 As Integer, ByVal KeyIndex2 As Integer)
        temp_k = Key_temp(KeyIndex1)
        Key_temp(KeyIndex1) = Key_temp(KeyIndex2)
        Key_temp(KeyIndex2) = temp_k
    End Sub

#End Region

#Region " Generation of Key to Dispense Hopper Coins"

    Private Sub create_Sending_Key()
        Dim i As Integer
        Dispense_HopperCoin_TX(0) = &H3
        Dispense_HopperCoin_TX(1) = &H9
        Dispense_HopperCoin_TX(2) = &H1
        Dispense_HopperCoin_TX(3) = &HA7
        For i = 1 To 8
            Dispense_HopperCoin_TX(3 + i) = Key_temp(i - 1)
        Next
        Dispense_HopperCoin_TX(12) = Hex(CLng(HexaCoins))
        Dispense_HopperCoin_TX(13) = Hex(CLng(Create_Checksum()))
    End Sub

#End Region

#End Region

#Region " Create Checksum for Transmission"

    Private Function Create_Checksum() As String
        Dim Sum_of_key As Integer = 3 + 9 + 1 + 167
        Dim chkdigit, j As Integer
        Try

            For i As Integer = 0 To 7
                Sum_of_key = Sum_of_key + CDec(Key_temp(i))
            Next
            Sum_of_key = Sum_of_key + CDec(NoofCoins)
            Do
                chkdigit = 256 * j
                j = j + 1
            Loop Until chkdigit >= Sum_of_key
            'Dim checksum As Integer

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        Return Str(chkdigit - Sum_of_key)
    End Function

#End Region

End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Software Developer (Junior)
India India
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions