2004-03-22 09:15

'**********************************************************************
'File...... ModbusCRCcalc.bas
'Purpose... calculates a Modbus cyclic redundancy check (CRC)
'Software.. Rapid-Q Basic
'Author.... Brandon Tarr
'Version... 1.0
'**********************************************************************

     $APPTYPE   GUI
     $TYPECHECK ON
     $ESCAPECHARS ON
     $INCLUDE "Rapidq.inc"

     DECLARE SUB mhelp
     DECLARE SUB mabout
     DECLARE SUB update

     DECLARE FUNCTION hexvalue(char AS STRING) AS INTEGER
     DECLARE FUNCTION calccrc(pktbyte AS INTEGER) AS INTEGER

     DIM polynomial AS INTEGER : polynomial = &hA001
     DIM crc AS INTEGER : crc = &hFFFF

     CREATE Form AS QFORM
      CAPTION = "Modbus CRC Calculator"
      Width = 300
      Height = 115
      Center
      CREATE mainmnu AS QMAINMENU
       CREATE filemnu AS QMENUITEM
        CAPTION = "&Help"
        CREATE mnunew AS QMENUITEM
         CAPTION = "&Help"
         onclick = mhelp
        END CREATE
        CREATE mnuopen AS QMENUITEM
         CAPTION = "&About"
         onclick = mabout
        END CREATE
       END CREATE
      END CREATE
      CREATE Label1 AS QLABEL
       CAPTION = "Hex string:"
       Left = 5
       Top = 12
      END CREATE
      CREATE packetvalue AS QEDIT
       Text = ""
       Left = 60
       Top = 10
       width = 225
       height = 21
       onchange = update
      END CREATE
      CREATE Label2 AS QLABEL
       CAPTION = "CRC:  0x"
       Left =115
       Top = 45
      END CREATE
      CREATE crcvalue AS QLABEL
       CAPTION = "0000"
       Left = 158
       Top = 45
       Width = 30
      END CREATE
     END CREATE

     FUNCTION hexvalue(char)
      DIM e AS INTEGER
      e=ASC(char)
      hexvalue=ABS(((e>=48 AND e<=57)*(e-48))+((e>=65 AND e<=70)*(e-55))+((e>=97 AND e<=102)*(e-87)))
     END FUNCTION

     FUNCTION calccrc(pktbyte)
      DIM bitcnt AS INTEGER
      DIM shiftbit AS INTEGER
      crc = crc XOR pktbyte
      bitcnt = 0
      WHILE bitcnt < 8
       shiftbit = crc AND 1
       crc = crc SHR 1
       IF shiftbit = 1 THEN
        crc = crc XOR polynomial
       END IF
       bitcnt = bitcnt + 1
      WEND
      calccrc = crc
     END FUNCTION

     SUB update
      DIM packet AS STRING
      DIM stringlen AS INTEGER
      DIM i AS INTEGER
      DIM msb AS STRING
      DIM lsb AS STRING
      DIM pktbyte AS INTEGER
      crc = &hFFFF
      packet = packetvalue.text
      stringlen = LEN(packet)
      i=1
      WHILE i<=stringlen
       msb = MID$(packet,i,1)
       lsb = MID$(packet,i+1,1)
       pktbyte = (hexvalue(msb)*16)+hexvalue(lsb)
       crc = calccrc(pktbyte)
       i = i + 2
      WEND
      crcvalue.CAPTION = RIGHT$(HEX$(crc),4)
     END SUB

     SUB mhelp
      MESSAGEBOX("Usage:  Simply enter the hexadecimal string that you \n"+_
       "wish to send, and the CRC value is generated on the fly. \n \n"+_
       "Be sure to include zeros in the string where necessary, \n"+_
       "and do not use any commas or spaces between values. \n"+_
       "You must reverse the MSB and LSB, as per the Modbus standard, \n"+_
       "before you append the values to the end of the packet.","Modbus CRC Calculator Help",&h40)
     END SUB

     SUB mabout
      MESSAGEBOX("Modbus CRC Calculator Version 1.0\n \n"+_
       "Written by Brandon A. Tarr using Rapid-Q Basic.\n \n"+_
       "This program is distributed as freeware.\n"+_
       "It may be redistributed, disassembled, reverse engineered, etc.\n"+_
       "as long as it remains completely and absolutely free.","About Modbus CRC Calculator",&h40)
     END SUB

     Form.SHOWMODAL

2004-03-22 09:15