ModBus-CRC-Local-Version-routine-v1

'* '* File: MBUS_CRC.BAS '* CRC-16 (reverse) table lookup for Modbus CRC-16 '* '* Project: Modbus '* Author: Lynn August Linse, based on method used by XMODEM '* Language: Visual Basic v3.0 '* '* History: '*/

'* CalcCRC can be used both to create a Modbus CRC and to verify an existing '* CRC value. If nSize includes only the message bytes, then the value '* returned will be the 16-bit CRC value to use. If nSize also includes '* the last 2 CRC bytes, then the return will be 0 if the CRC is Ok. '*/

'/* This table occupies 512 bytes and was calculated using an algorithm from ' * the XMODEM protocol */ Dim usCRC(0 To 255) As Long

' Given a String, Calc a modbus style CRC-16 by look-up table Function mbus_CalcCRCString(sBuf As String) As Long

  Dim x As Long
  Dim crc As Long
  Dim i As Integer

  If (usCRC(1) <> &HC0C1) Then
     mbus_FillCRCTable
  End If
   
  crc = 65535                    ' start with all 1's for a reverse CRC
  For i = 1 To Len(sBuf)         ' process each character in the message */
     x = Asc(Mid(sBuf, i, 1))    ' get next char
     x = (crc Xor x) And 255     '
     x = usCRC(x) And 65535      '
     crc = (crc \ 256) Xor x
  Next i
  mbus_CalcCRCString = crc

End Function

' Given an Integer array, Calc a modbus style CRC-16 by look-up table Function mbus_CalcCRC(nBuf() As Integer, nSize As Integer) As Long

  Dim x As Long
  Dim crc As Long
  Dim i As Integer

  If (usCRC(1) <> &HC0C1) Then
     mbus_FillCRCTable
  End If
   
  crc = 65535                     ' start with all 1's for a reverse CRC
  For i = 1 To nSize              ' process each character in the message */
     x = nBuf(i)                 ' get next char
     x = (crc Xor x) And 255     '
     x = usCRC(x) And 65535      '
     crc = (crc \ 256) Xor x
  Next i
  mbus_CalcCRC = crc

End Function

' given a Byte, Calc a modbus style CRC-16 by look-up table Function mbus_CalcOneCRC(nByte As Integer, lCrc As Long) As Long

  Dim n As Long
  If (usCRC(1) <> &HC0C1) Then
     mbus_FillCRCTable
  End If

  n = nByte
  n = (crc Xor n) And 255  '
  n = usCRC(n) And 65535   '
  mbus_CalcOneCRC = (lCrc \ 256) Xor n

End Function

Sub mbus_FillCRCTable()

   ' This is a very silly function, but I cannot think
   ' of a better way to init this array (other than .DLL)
   ' VB doesn't have the DATA/READ statement used by earlier BASIC

   Debug.Print "Filling CRC Table"

   usCRC(0) = &H0: usCRC(1) = &HC0C1: usCRC(2) = &HC181: usCRC(3) = &H140
   usCRC(4) = &HC301: usCRC(5) = &H3C0: usCRC(6) = &H280: usCRC(7) = &HC241
   usCRC(8) = &HC601: usCRC(9) = &H6C0: usCRC(10) = &H780: usCRC(11) = &HC741
   usCRC(12) = &H500: usCRC(13) = &HC5C1: usCRC(14) = &HC481: usCRC(15) = &H440
   usCRC(16) = &HCC01: usCRC(17) = &HCC0: usCRC(18) = &HD80: usCRC(19) = &HCD41
   usCRC(20) = &HF00: usCRC(21) = &HCFC1: usCRC(22) = &HCE81: usCRC(23) = &HE40
   usCRC(24) = &HA00: usCRC(25) = &HCAC1: usCRC(26) = &HCB81: usCRC(27) = &HB40
   usCRC(28) = &HC901: usCRC(29) = &H9C0: usCRC(30) = &H880: usCRC(31) = &HC841
   usCRC(32) = &HD801: usCRC(33) = &H18C0: usCRC(34) = &H1980: usCRC(35) = &HD941
   usCRC(36) = &H1B00: usCRC(37) = &HDBC1: usCRC(38) = &HDA81: usCRC(39) = &H1A40
   usCRC(40) = &H1E00: usCRC(41) = &HDEC1: usCRC(42) = &HDF81: usCRC(43) = &H1F40
   usCRC(44) = &HDD01: usCRC(45) = &H1DC0: usCRC(46) = &H1C80: usCRC(47) = &HDC41
   usCRC(48) = &H1400: usCRC(49) = &HD4C1: usCRC(50) = &HD581: usCRC(51) = &H1540
   usCRC(52) = &HD701: usCRC(53) = &H17C0: usCRC(54) = &H1680: usCRC(55) = &HD641
   usCRC(56) = &HD201: usCRC(57) = &H12C0: usCRC(58) = &H1380: usCRC(59) = &HD341
   usCRC(60) = &H1100: usCRC(61) = &HD1C1: usCRC(62) = &HD081: usCRC(63) = &H1040
   usCRC(64) = &HF001: usCRC(65) = &H30C0: usCRC(66) = &H3180: usCRC(67) = &HF141
   usCRC(68) = &H3300: usCRC(69) = &HF3C1: usCRC(70) = &HF281: usCRC(71) = &H3240
   usCRC(72) = &H3600: usCRC(73) = &HF6C1: usCRC(74) = &HF781: usCRC(75) = &H3740
   usCRC(76) = &HF501: usCRC(77) = &H35C0: usCRC(78) = &H3480: usCRC(79) = &HF441
   usCRC(80) = &H3C00: usCRC(81) = &HFCC1: usCRC(82) = &HFD81: usCRC(83) = &H3D40
   usCRC(84) = &HFF01: usCRC(85) = &H3FC0: usCRC(86) = &H3E80: usCRC(87) = &HFE41
   usCRC(88) = &HFA01: usCRC(89) = &H3AC0: usCRC(90) = &H3B80: usCRC(91) = &HFB41
   usCRC(92) = &H3900: usCRC(93) = &HF9C1: usCRC(94) = &HF881: usCRC(95) = &H3840
   usCRC(96) = &H2800: usCRC(97) = &HE8C1: usCRC(98) = &HE981: usCRC(99) = &H2940
   usCRC(100) = &HEB01: usCRC(101) = &H2BC0: usCRC(102) = &H2A80: usCRC(103) = &HEA41
   usCRC(104) = &HEE01: usCRC(105) = &H2EC0: usCRC(106) = &H2F80: usCRC(107) = &HEF41
   usCRC(108) = &H2D00: usCRC(109) = &HEDC1: usCRC(110) = &HEC81: usCRC(111) = &H2C40
   usCRC(112) = &HE401: usCRC(113) = &H24C0: usCRC(114) = &H2580: usCRC(115) = &HE541
   usCRC(116) = &H2700: usCRC(117) = &HE7C1: usCRC(118) = &HE681: usCRC(119) = &H2640
   usCRC(120) = &H2200: usCRC(121) = &HE2C1: usCRC(122) = &HE381: usCRC(123) = &H2340
   usCRC(124) = &HE101: usCRC(125) = &H21C0: usCRC(126) = &H2080: usCRC(127) = &HE041
   usCRC(128) = &HA001: usCRC(129) = &H60C0: usCRC(130) = &H6180: usCRC(131) = &HA141
   usCRC(132) = &H6300: usCRC(133) = &HA3C1: usCRC(134) = &HA281: usCRC(135) = &H6240
   usCRC(136) = &H6600: usCRC(137) = &HA6C1: usCRC(138) = &HA781: usCRC(139) = &H6740
   usCRC(140) = &HA501: usCRC(141) = &H65C0: usCRC(142) = &H6480: usCRC(143) = &HA441
   usCRC(144) = &H6C00: usCRC(145) = &HACC1: usCRC(146) = &HAD81: usCRC(147) = &H6D40
   usCRC(148) = &HAF01: usCRC(149) = &H6FC0: usCRC(150) = &H6E80: usCRC(151) = &HAE41
   usCRC(152) = &HAA01: usCRC(153) = &H6AC0: usCRC(154) = &H6B80: usCRC(155) = &HAB41
   usCRC(156) = &H6900: usCRC(157) = &HA9C1: usCRC(158) = &HA881: usCRC(159) = &H6840
   usCRC(160) = &H7800: usCRC(161) = &HB8C1: usCRC(162) = &HB981: usCRC(163) = &H7940
   usCRC(164) = &HBB01: usCRC(165) = &H7BC0: usCRC(166) = &H7A80: usCRC(167) = &HBA41
   usCRC(168) = &HBE01: usCRC(169) = &H7EC0: usCRC(170) = &H7F80: usCRC(171) = &HBF41
   usCRC(172) = &H7D00: usCRC(173) = &HBDC1: usCRC(174) = &HBC81: usCRC(175) = &H7C40
   usCRC(176) = &HB401: usCRC(177) = &H74C0: usCRC(178) = &H7580: usCRC(179) = &HB541
   usCRC(180) = &H7700: usCRC(181) = &HB7C1: usCRC(182) = &HB681: usCRC(183) = &H7640
   usCRC(184) = &H7200: usCRC(185) = &HB2C1: usCRC(186) = &HB381: usCRC(187) = &H7340
   usCRC(188) = &HB101: usCRC(189) = &H71C0: usCRC(190) = &H7080: usCRC(191) = &HB041
   usCRC(192) = &H5000: usCRC(193) = &H90C1: usCRC(194) = &H9181: usCRC(195) = &H5140
   usCRC(196) = &H9301: usCRC(197) = &H53C0: usCRC(198) = &H5280: usCRC(199) = &H9241
   usCRC(200) = &H9601: usCRC(201) = &H56C0: usCRC(202) = &H5780: usCRC(203) = &H9741
   usCRC(204) = &H5500: usCRC(205) = &H95C1: usCRC(206) = &H9481: usCRC(207) = &H5440
   usCRC(208) = &H9C01: usCRC(209) = &H5CC0: usCRC(210) = &H5D80: usCRC(211) = &H9D41
   usCRC(212) = &H5F00: usCRC(213) = &H9FC1: usCRC(214) = &H9E81: usCRC(215) = &H5E40
   usCRC(216) = &H5A00: usCRC(217) = &H9AC1: usCRC(218) = &H9B81: usCRC(219) = &H5B40
   usCRC(220) = &H9901: usCRC(221) = &H59C0: usCRC(222) = &H5880: usCRC(223) = &H9841
   usCRC(224) = &H8801: usCRC(225) = &H48C0: usCRC(226) = &H4980: usCRC(227) = &H8941
   usCRC(228) = &H4B00: usCRC(229) = &H8BC1: usCRC(230) = &H8A81: usCRC(231) = &H4A40
   usCRC(232) = &H4E00: usCRC(233) = &H8EC1: usCRC(234) = &H8F81: usCRC(235) = &H4F40
   usCRC(236) = &H8D01: usCRC(237) = &H4DC0: usCRC(238) = &H4C80: usCRC(239) = &H8C41
   usCRC(240) = &H4400: usCRC(241) = &H84C1: usCRC(242) = &H8581: usCRC(243) = &H4540
   usCRC(244) = &H8701: usCRC(245) = &H47C0: usCRC(246) = &H4680: usCRC(247) = &H8641
   usCRC(248) = &H8201: usCRC(249) = &H42C0: usCRC(250) = &H4380: usCRC(251) = &H8341
   usCRC(252) = &H4100: usCRC(253) = &H81C1: usCRC(254) = &H8081: usCRC(255) = &H4040

End Sub