Re: How to do CRC's in QB

 BBS: Inland Empire Archive
Date: 09-14-92 (18:46)             Number: 315
From: DICK DENNISON                Refer#: NONE
  To: BOB EDWARDS                   Recvd: NO  
Subj: Re: How to do CRC's in QB      Conf: (2) Quik_Bas

->How does the CRC alagorithm go, and how do I adapt this to QB to make
->CRC's there?

BE> I'll second that request.  This sound like a good topic to cover
BE> along with (1) compression, (2) file transfer protocols

Ok, you asked for it.  This is a routine I use to make the new CRC16
(CCIT spec) for our local network.  The crc16 routine is copyright Donn
Bly, so be advised to read the fine print enclosed, although the
algorhythm is PD.  This routine has not been optimized, so I don't want
to hear complaints.

'DIX CRC computes CCIT CRC for small nodelists for pdq
'Dick Dennison  1:272/34  74270,3636@compuserve.com
'12/15/91 stuffs crc into nodelist
'1/7/92 allow for leading zeros

DECLARE FUNCTION PDQTimer&
DECLARE FUNCTION Computecrc& (x$)         'from Donn Bly

DIM a AS STRING * 1

IF COMMAND$ = "" THEN
     PRINT "Enter nodelist number : ";
     LINE INPUT ab$
ELSE ab$ = COMMAND$
END IF

spec$ = "nodelist." + ab$

OPEN spec$ FOR INPUT AS 1      'throw away first line
   LINE INPUT #1, oneline$
   begin% = SEEK(1)
   replace% = begin% - 7  'where the CRC number is to go later
CLOSE 1

OPEN spec$ FOR BINARY AS 1   'nodelist name with first line
   SEEK 1, begin%
   Lenfile& = LOF(1) - begin%


FOR n& = 1 TO Lenfile&            'this could easily be optimized
    GET 1, , a$                   'with B$GETx
    crc& = Computecrc&(a$)
NEXT n&

CLOSE 1

PRINT "Decimal CRC : "; crc&
textcrc$ = LTRIM$(STR$(crc&))
IF LEN(textcrc$) < 5 THEN textcrc$ = STRING$(5 - LEN(textcrc$), "0") + tex
tcrc$

OPEN spec$ FOR BINARY AS 1
SEEK 1, replace%
PUT 1, , textcrc$
CLOSE 1

FUNCTION Computecrc& (x$)
' ComputeCRC - Copyright (C) 1989, Donn Bly, 1:236/7.0
'
' Standard Donn Bly Licencing Agreement:
'  This code may be used for anything that you want, except for profit.  I
f
'  you want to profit from my work you had better talk to me first.
'  NOTE: The CRC Polynomial was redone by Dick Dennison for CCIT16
STATIC InputByte AS INTEGER, CRCword AS LONG, c%, FeedBackBit AS INTEGER
'
' CRC Calculation Polynomial = X^16+X^12+X^5+X^0     (CCIT 16)
'
' X$ is the block on which to compute the CRC
'
'CRCword = 0  'this line is Dick's
FOR c% = 1 TO LEN(x$)
   InputByte = ASC(MID$(x$, c%, 1))
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 128) =
128)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 64) = 6
4)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 32) = 3
2)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 16) = 1
6)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 8) = 8)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 4) = 4)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 2) = 2)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 1) = 1)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
NEXT c%
Computecrc& = CRCword&
END FUNCTION

'Sorry for the line wrap.  Also be advised that there are at least two
common CRC16 polynomials and either will yeild a different CRC.  For
more info on CRC's, look up 'C Programmer's Guide to serial Comm.' by
Joe Campbell, Sams & Co., ISBN 0-672-22584-0.  Feel free to abuse/use.


--- VP [DOS] V4.09e
 * Origin: The MailMan  (914)374-3903 NY Quick Share Pt #7 *HST (1:272/34)