CRC calculation

[kolonuk]

Hi All,

Has anyone done any CRC calculation with Progress? I need to send an image to a Zebra printer, and it insists on needing a crc-ccitt string is 4 digit hex.

I have a VB example that I am trying to convert to Progress, but it is going to involve a lot of fiddling with "fake" variables when dealing with "hi" and "lo" bits, and not-so-simple "xor":

Private Function CRC16(ByVal crc As Integer, d As Byte) As Integer
  Dim carry As Integer, i As Byte
  For i = 0 To 7
    carry = (crc And 1) Xor IIf(d And (2 ^ i), 1, 0)
    crc = (crc And &HFFFF&) \ 2
    If carry <> 0 Then crc = crc Xor &H8408
  Next i
  CRC16 = crc
End Function

Public Function CalcCrc16(ByVal buf As String) As String
  Dim crc As Integer, t As Integer
  crc = &H8408
  For t = 1 To Len(buf)
    crc = CRC16(crc, Asc(Mid$(buf, t, 1)))
  Next t
  CalcCrc16 = Chr$(HiByte(crc)) & Chr$(LoByte(crc))
End Function

I'm just wondering if anyone has any experience which can save me the best part of a day (or more!) trying to make this work!

Thanks in advance!

 

[GregTomkins]

Wow! A question that is both interesting and a little difficult. Don't hold your breath.

 

[Stefan]

20 minutes, totally untested, totally unoptimized, but should get you started:

FUNCTION getbit RETURNS LOGICAL PRIVATE (
   i_i      AS INTEGER,
   i_ibit   AS INTEGER
):
   DEFINE VARIABLE ii      AS INTEGER     NO-UNDO.
   
   DO ii = 0 TO i_ibit - 1:
      i_i = TRUNCATE( i_i / 2, 0 ).
   END.
   RETURN ( i_i MODULO 2 ) = 1.
END FUNCTION. /* getbit */
FUNCTION setbit RETURNS INTEGER PRIVATE (
   i_i      AS INTEGER,
   i_ibit   AS INTEGER
):
   IF NOT getbit( i_i, i_ibit ) THEN
      i_i = i_i + EXP( 2, i_ibit ).
   RETURN i_i.
END FUNCTION. /* setbit */
FUNCTION band RETURNS INTEGER PRIVATE (
   i_i1     AS INTEGER,
   i_i2     AS INTEGER
):
   DEFINE VARIABLE ii      AS INTEGER     NO-UNDO.
   DEFINE VARIABLE iresult AS INTEGER     NO-UNDO.
   DO ii = 0 TO 15:
      IF getbit( i_i1, ii ) AND
         getbit( i_i2, ii )
      THEN
         iresult = setbit( iresult, ii ).
   END.
   RETURN iresult.
END FUNCTION. /* band */
FUNCTION bxor RETURNS INTEGER PRIVATE (
   i_i1     AS INTEGER,
   i_i2     AS INTEGER
):
   DEFINE VARIABLE ii      AS INTEGER     NO-UNDO.
   DEFINE VARIABLE iresult AS INTEGER     NO-UNDO.
   DO ii = 0 TO 15:
      IF getbit( i_i1, ii ) <>
         getbit( i_i2, ii )
      THEN
         iresult = setbit( iresult, ii ).
   END.
   RETURN iresult.
END FUNCTION. /* bxor */
/*
Private Function CRC16(ByVal crc As Integer, d As Byte) As Integer
  Dim carry As Integer, i As Byte
  For i = 0 To 7
    carry = (crc And 1) Xor IIf(d And (2 ^ i), 1, 0)
    crc = (crc And &HFFFF&) \ 2
    If carry <> 0 Then crc = crc Xor &H8408
  Next i
  CRC16 = crc
End Function
*/
FUNCTION CRC16 RETURNS INTEGER PRIVATE (
   i_icrc   AS INTEGER,
   i_d      AS INTEGER
):
   DEFINE VARIABLE icarry  AS INTEGER     NO-UNDO.
   DEFINE VARIABLE ii      AS INTEGER     NO-UNDO.
   DO ii = 0 TO 7:
      
      icarry = bxor( band( i_icrc, 1 ), IF band( i_d, INTEGER( EXP( 2, ii ) ) ) = 1 THEN 1 ELSE 0 ).
      i_icrc = band( i_icrc, 65535 /* &HFFFF& */ ) MODULO 2.
      IF icarry <> 0 THEN
         i_icrc = bxor( i_icrc, 33800 /* &H8408& */ ).
   END.
   RETURN i_icrc.
END FUNCTION. /* CRC16 */
/*
Public Function CalcCrc16(ByVal buf As String) As String
  Dim crc As Integer, t As Integer
  crc = &H8408
  For t = 1 To Len(buf)
    crc = CRC16(crc, Asc(Mid$(buf, t, 1)))
  Next t
  CalcCrc16 = Chr$(HiByte(crc)) & Chr$(LoByte(crc))
End Function
*/
FUNCTION CalcCrc16 RETURNS CHARACTER (
   i_cbuf   AS CHARACTER
):
   DEFINE VARIABLE icrc AS INTEGER     NO-UNDO.
   DEFINE VARIABLE it   AS INTEGER     NO-UNDO.
   icrc = 33800 /* &H8408& */.
   DO it = 1 TO LENGTH( i_cbuf ):
      icrc = CRC16( icrc, ASC( SUBSTRING( i_cbuf, it, 1 ) ) ).
   END.
   RETURN CHR( TRUNCATE( icrc / 256, 0 ) ) + CHR( icrc MODULO 256 ).
END FUNCTION. /* CalcCrc16 */

 

[kolonuk]

I know I'm resurecting my old thread, but the ENCODE() function works... ;-)