Newsgroup: it.comp.lang.visual-basic
Titolo: [Miniguide] Calcolo del BCC di una stringa (non CRC)

Ciao a tutti,
posto un esempio di codice per calcolare il Block Check Char (BCC) di una
stringa.
Viene usato in alternativa al CRC quando si hanno trasmissioni via seriali
come carattere di controllo finale (es. letture/invio dati da strumenti).
 
Di mio non c'è nulla, ma ho messo insieme varie routine prese su internet,
che non si trovano proprio in modo immediato.
 
Uso:
CalculateBCC("Questa è la stringa da convertire." & chr$(3))
Risultato "B7"
 
Da mettere in un modulo:
 
| Option Explicit
| 
| Private Function HexToInt(strSub As String) As Integer
| '---------------------------------------------------------------------------------------
| ' Procedure : HexToInt
| ' DateTime  : 07/11/2003 12:54
| ' Author    : Matthew Knight
| ' Purpose   : Rather Brute Hex to Int Conversion
| '           : Assumes that the string will be 2 valid hex char long
| '---------------------------------------------------------------------------------------
| '
|     Dim intResult As Integer
|     intResult = (16 * HX(Left$(strSub, 1))) + HX(Right$(strSub, 1))
| 
|     HexToInt = intResult
| End Function
| 
| Private Function HX(strSub As String) As Integer
| '---------------------------------------------------------------------------------------
| ' Procedure : HX
| ' DateTime  : 07/11/2003 12:54
| ' Author    : Matthew Knight
| ' Purpose   : even more Brute Hex to Int Conversion
| '           : Assumes single valid hex char
| '---------------------------------------------------------------------------------------
| '
|     Dim intResult As Integer
|     Select Case strSub
|     Case "A"
|     intResult = 10
|     Case "B"
|     intResult = 11
|     Case "C"
|     intResult = 12
|     Case "D"
|     intResult = 13
|     Case "E"
|     intResult = 14
|     Case "F"
|     intResult = 15
|     Case Else
|     intResult = CInt(strSub)
|     End Select
|     HX = intResult
| End Function
| 
| 
| Public Function CalculateBCC(ByVal strStream As String) As String
| '---------------------------------------------------------------------------------------
| ' Procedure : CalculateBCC
| ' DateTime  : 07/11/2003 12:56
| ' Author    : Matthew Knight
| ' Purpose   : Calculate BCC for stream of data
| '           : assumes STB has been removed
| '---------------------------------------------------------------------------------------
| '
| Dim intStringLen As Integer, intCount As Integer, intSub As Integer
| Dim strSub As String
| Dim intBCC As Integer, blnSkippedControl As Boolean
| 
| strStream = StrToHex(strStream)
| 
| intStringLen = Len(strStream)
| 
| For intCount = 1 To intStringLen Step 2
|     'Get our byte value
|     strSub = UCase$(Mid$(strStream, intCount, 2))
|     'Convert to decimal integer
|     intSub = HexToInt(strSub)
|     
|     
| If intSub = 16 And blnSkippedControl = False Then
|     'Set our flag to show we found a control code
|     'need to cope with situation where &H10 is valid data
|     'i.e. stream would look like ...1010...
|     blnSkippedControl = True
| Else
|     ' XOR this byte with result
|     intBCC = intBCC Xor intSub
|     blnSkippedControl = False
| 
| End If
| Next intCount
|     'convert to hex and return
|     CalculateBCC = Hex$(intBCC)
| 
| End Function
| 
| 
| 
| Private Function StrToHex(ByVal Text As String) As String
| '---------------------------------------------------------------------------------------
| ' Procedure : StrToHex
| ' Author    : Andrea
| ' Date      : 18/11/2014
| ' Purpose   : Converte un testo in Hex
| '---------------------------------------------------------------------------------------
| '
|     Dim tmpArr() As Byte, strArr() As Byte
|     Dim A As Long, B As Long, UpperBits As Byte, LowerBits As Byte
|     If LenB(Text) = 0 Then Exit Function
|     strArr = Text
|     ReDim tmpArr(LenB(Text) + LenB(Text) - 1)
|     For A = 0 To UBound(strArr) Step 2
|         UpperBits = (strArr(A) And &HF0) \ &H10
|         LowerBits = strArr(A) And &HF
|         B = A + A
|         If UpperBits > 10 Then
|             tmpArr(B) = (48 Or UpperBits) + 7
|         Else
|             tmpArr(B) = 48 Or UpperBits
|         End If
|         B = B + 2
|         If LowerBits > 10 Then
|             tmpArr(B) = (48 Or LowerBits) + 7
|         Else
|             tmpArr(B) = 48 Or LowerBits
|         End If
|     Next A
|     StrToHex = tmpArr
| End Function

|         End If
 
Invece di >10 sembra ci voglia un >=