CRC - abwiki @ ウィキ (ActiveBasic非公式wiki)

/***********************************************************
crc32t.c -- CRC
***********************************************************/

Const CRCPOLY1 = &h04C11DB7
/* xXor{32}+xXor{26}+xXor{23}+xXor{22}+xXor{16}+xXor{12}+xXor{11]+
xXor{10}+xXor8+xXor7+xXor5+xXor4+xXor2+xXor1+1 */
Const CRCPOLY2 = &hEDB88320 /* 左右逆転 */

Const UCHAR_MAX = 255
Const CHAR_BIT = 8
Dim crctable[UCHAR_MAX] As DWord

Sub makecrctable1()
Dim i As DWord, j As DWord
Dim r As DWord

For i=0 To UCHAR_MAX
r = i << (32 - CHAR_BIT)
For j=0 To CHAR_BIT-1
If (r And &h80000000) Then
r = (r << 1) Xor CRCPOLY1
Else
r = r << 1
End If
Next
crctable[i] = r And &hFFFFFFFF
Next
End Sub

Function crc1(n As Long, c As *Byte) As DWord
Dim r As DWord

r = &hFFFFFFFF
n=n-1
while (n >= 0)
r = (r << CHAR_BIT) Xor crctable[(r >> (32 - CHAR_BIT)) As Byte Xor GetByte(c)]
c++
n=n-1
Wend
crc1= Not r And &hFFFFFFFF
End Function

Sub makecrctable2()
Dim i As DWord, j As DWord
Dim r As DWord

For i=0 To UCHAR_MAX
r = i
For j=0 To CHAR_BIT-1
If (r And 1) Then
r = (r >> 1) Xor CRCPOLY2
Else
r = r >> 1
End If
Next
crctable[i] = r
Next
End Sub

Function crc2(n As Long, c As *Byte) As DWord
Dim r As DWord
Dim t As Byte
r = &hFFFFFFFF
n=n-1
while (n >= 0)
t = (r As Byte) Xor GetByte(c)
r = (r >> CHAR_BIT) Xor crctable[t]
c++
n=n-1
Wend
crc2= r Xor &hFFFFFFFF
End Function


#N88BASIC
Dim s As *Byte
Dim out[100] As Byte
s = "Hello, world!"
makecrctable1()
wsprintf(out, Ex"crc1(%s) = %08lX", s, crc1(13, s))
Print MakeStr(out)
makecrctable2()
wsprintf(out, Ex"crc2(%s) = %08lX", s, crc2(13, s))
Print MakeStr(out)