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