XProfan

Function Docrc8(ByVal s As String) As Byte
Dim j As Byte
Dim k As Byte
Dim crc8 As Byte
Dim m As Byte
Dim x As Byte
crc8 = 0
For m = 1 To Len(s)
x = Asc(Mid(s, m, 1))
For k = 0 To 7
j = 1 And (x Xor crc8)
crc8 = Fix(crc8 / 2) And &HFF
x = Fix(x / 2) And &HFF

If j <> 0 Then

    crc8 = crc8 Xor &H8C
    End If
    Next k
    Next
    Docrc8 = crc8
    End Function

proc Docrc8

    parameters s$
    declare j&,k&,crc8&,x&
    crc8& = 0

    whileLoop len(s$)

        x& = ord(mid$(s$,&loop,1))

        whileLoop 0,7

            j& = 1 & xor(x&,crc8&)
            crc8& = abs(crc8&  2) & $FF
            x& = abs(x&  2) & $FF

            If j& <> 0

                crc8& = xor(crc8&,$8C)

            endif

        wend

    wend

    return crc8&

endproc

print Docrc8("test")
waitinput