'===========================================================================
' Subject: CALCULATING CRC BLOCKS            Date: Unknown Date (00:00)   
' Author:  Unknown Author(s)                 Code: QB, QBasic, PDS        
' Keys:    CALCULATING,CRC,BLOCKS          Packet: ALGOR.ABC
'===========================================================================
'=== BEGIN: CRC.BAS ===
DECLARE FUNCTION CRC16& (Block$)
DECLARE FUNCTION CRC32& (Block$)
'=== END ===

DEFINT A-Z
FUNCTION CRC16& (B$)      'Calculates CRC for Each Block

DIM Power(0 TO 7)                              'For the 8 Powers of 2
DIM CRC AS LONG

FOR I = 0 TO 7                                 'Calculate Once PerBlock to
   Power(I) = 2 ^ I                            ' Increase Speed Within FOR J
NEXT I                                         ' Loop
CRC = 0                                        'Reset for Each Text Block
FOR I = 1 TO LEN(B$)                           'Calculate for Length of Block
   ByteVal = ASC(MID$(B$, I, 1))
   FOR J = 7 TO 0 STEP -1
      TestBit = ((CRC AND 32768) = 32768) XOR ((ByteVal AND Power(J)) = Power(J))
      CRC = ((CRC AND 32767&) * 2&)
      IF TestBit THEN CRC = CRC XOR &H1021&     ' <-- This for 16 Bit CRC
   NEXT J
NEXT I
CRC16& = CRC                               'Return the Word Value
END FUNCTION

DEFSNG A-Z
FUNCTION CRC32& (B$)      'Calculates CRC for Each Block

DIM Power(0 TO 7)                              'For the 8 Powers of 2
DIM CRC AS LONG

FOR I = 0 TO 7                                 'Calculate Once Per Block to
   Power(I) = 2 ^ I                            ' Increase Speed Within FOR J
NEXT I                                         ' Loop
CRC = 0                                        'Reset for Each Text Block
FOR I = 1 TO LEN(B$)                           'Calculate for Length of Block
   ByteVal = ASC(MID$(B$, I, 1))
   FOR J = 7 TO 0 STEP -1
      TestBit = ((CRC AND 32768) = 32768) XOR ((ByteVal AND Power(J)) = Power(J))
      CRC = ((CRC AND 32767&) * 2&)
      IF TestBit THEN CRC = CRC XOR &H8005&     ' <-- This for 32 Bit CRC
   NEXT J
NEXT I
CRC32& = CRC                               'Return the Word Value
END FUNCTION