XProfan

 {$cliq}
Declare CrcTab#
Dim CrcTab#,1024

Proc Init_CrcTab

    Long CrcTab#,0   = $00000000,$77073096,$ee0e612c,$990951ba,$076dc419,$706af48f,$e963a535,$9e6495a3
    Long CrcTab#,8   = $0edb8832,$79dcb8a4,$e0d5e91e,$97d2d988,$09b64c2b,$7eb17cbd,$e7b82d07,$90bf1d91
    Long CrcTab#,16  = $1db71064,$6ab020f2,$f3b97148,$84be41de,$1adad47d,$6ddde4eb,$f4d4b551,$83d385c7
    Long CrcTab#,24  = $136c9856,$646ba8c0,$fd62f97a,$8a65c9ec,$14015c4f,$63066cd9,$fa0f3d63,$8d080df5
    Long CrcTab#,32  = $3b6e20c8,$4c69105e,$d56041e4,$a2677172,$3c03e4d1,$4b04d447,$d20d85fd,$a50ab56b
    Long CrcTab#,40  = $35b5a8fa,$42b2986c,$dbbbc9d6,$acbcf940,$32d86ce3,$45df5c75,$dcd60dcf,$abd13d59
    Long CrcTab#,48  = $26d930ac,$51de003a,$c8d75180,$bfd06116,$21b4f4b5,$56b3c423,$cfba9599,$b8bda50f
    Long CrcTab#,56  = $2802b89e,$5f058808,$c60cd9b2,$b10be924,$2f6f7c87,$58684c11,$c1611dab,$b6662d3d
    Long CrcTab#,64  = $76dc4190,$01db7106,$98d220bc,$efd5102a,$71b18589,$06b6b51f,$9fbfe4a5,$e8b8d433
    Long CrcTab#,72  = $7807c9a2,$0f00f934,$9609a88e,$e10e9818,$7f6a0dbb,$086d3d2d,$91646c97,$e6635c01
    Long CrcTab#,80  = $6b6b51f4,$1c6c6162,$856530d8,$f262004e,$6c0695ed,$1b01a57b,$8208f4c1,$f50fc457
    Long CrcTab#,88  = $65b0d9c6,$12b7e950,$8bbeb8ea,$fcb9887c,$62dd1ddf,$15da2d49,$8cd37cf3,$fbd44c65
    Long CrcTab#,96  = $4db26158,$3ab551ce,$a3bc0074,$d4bb30e2,$4adfa541,$3dd895d7,$a4d1c46d,$d3d6f4fb
    Long CrcTab#,104 = $4369e96a,$346ed9fc,$ad678846,$da60b8d0,$44042d73,$33031de5,$aa0a4c5f,$dd0d7cc9
    Long CrcTab#,112 = $5005713c,$270241aa,$be0b1010,$c90c2086,$5768b525,$206f85b3,$b966d409,$ce61e49f
    Long CrcTab#,120 = $5edef90e,$29d9c998,$b0d09822,$c7d7a8b4,$59b33d17,$2eb40d81,$b7bd5c3b,$c0ba6cad
    Long CrcTab#,128 = $edb88320,$9abfb3b6,$03b6e20c,$74b1d29a,$ead54739,$9dd277af,$04db2615,$73dc1683
    Long CrcTab#,136 = $e3630b12,$94643b84,$0d6d6a3e,$7a6a5aa8,$e40ecf0b,$9309ff9d,$0a00ae27,$7d079eb1
    Long CrcTab#,144 = $f00f9344,$8708a3d2,$1e01f268,$6906c2fe,$f762575d,$806567cb,$196c3671,$6e6b06e7
    Long CrcTab#,152 = $fed41b76,$89d32be0,$10da7a5a,$67dd4acc,$f9b9df6f,$8ebeeff9,$17b7be43,$60b08ed5
    Long CrcTab#,160 = $d6d6a3e8,$a1d1937e,$38d8c2c4,$4fdff252,$d1bb67f1,$a6bc5767,$3fb506dd,$48b2364b
    Long CrcTab#,168 = $d80d2bda,$af0a1b4c,$36034af6,$41047a60,$df60efc3,$a867df55,$316e8eef,$4669be79
    Long CrcTab#,176 = $cb61b38c,$bc66831a,$256fd2a0,$5268e236,$cc0c7795,$bb0b4703,$220216b9,$5505262f
    Long CrcTab#,184 = $c5ba3bbe,$b2bd0b28,$2bb45a92,$5cb36a04,$c2d7ffa7,$b5d0cf31,$2cd99e8b,$5bdeae1d
    Long CrcTab#,192 = $9b64c2b0,$ec63f226,$756aa39c,$026d930a,$9c0906a9,$eb0e363f,$72076785,$05005713
    Long CrcTab#,200 = $95bf4a82,$e2b87a14,$7bb12bae,$0cb61b38,$92d28e9b,$e5d5be0d,$7cdcefb7,$0bdbdf21
    Long CrcTab#,208 = $86d3d2d4,$f1d4e242,$68ddb3f8,$1fda836e,$81be16cd,$f6b9265b,$6fb077e1,$18b74777
    Long CrcTab#,216 = $88085ae6,$ff0f6a70,$66063bca,$11010b5c,$8f659eff,$f862ae69,$616bffd3,$166ccf45
    Long CrcTab#,224 = $a00ae278,$d70dd2ee,$4e048354,$3903b3c2,$a7672661,$d06016f7,$4969474d,$3e6e77db
    Long CrcTab#,232 = $aed16a4a,$d9d65adc,$40df0b66,$37d83bf0,$a9bcae53,$debb9ec5,$47b2cf7f,$30b5ffe9
    Long CrcTab#,240 = $bdbdf21c,$cabac28a,$53b39330,$24b4a3a6,$bad03605,$cdd70693,$54de5729,$23d967bf
    Long CrcTab#,248 = $b3667a2e,$c4614ab8,$5d681b02,$2a6f2b94,$b40bbe37,$c30c8ea1,$5a05df1b,$2d02ef8d

EndProc

Proc Done_CrcTab

    Dispose CrcTab#

EndProc

Crc32 ist eine additive Funktion; sie kann mehrmals hintereinander mit unterschiedlichen
Daten aufgerufen werden. Wenn dabei jeweils die letzte CRC übergeben wird kann auf diese
Weise eine CRC über eine riesige (in Häppchen eingelesene) Datei gebildet werden.
Wird der dritte Parameter nicht angegeben, so wird eine neue CRC gebildet.

Proc Crc32

    If %PCount > 2

        Parameters BereichAdr&,Groesse&,CrcAlt&

    Else

        Parameters BereichAdr&,Groesse&
        Declare CrcAlt&

    EndIf

    Declare Crc&

    AsmStart Crc32_ASM

        Parameters Addr(CrcTab#),CrcAlt&,BereichAdr&,Groesse&
        Return Crc&
        mov  ebx,para2  ; CrcAlt&
        mov  eax,ebx
        mov  esi,para1  ; CrcTab&
        mov  edi,para3  ; BereichAdr&
        mov  ecx,para4  ; Groesse&

        .if ecx>=0

            @@:
            xor  eax,eax
            mov  al,[edi]
            xor  al,bl
            shl  eax,2
            mov  eax,[esi + eax]
            shr  ebx,8
            xor  eax,ebx
            mov  ebx,eax
            inc  edi
            loop @B

        .endif

    AsmEnd

    Return Crc&

EndProc

Proc MyHex$

    If %PCount > 2

        Parameters Wert&,Laenge%,Grp%

    Else

        Parameters Wert&,Laenge%
        Declare Grp%
        Grp% = 64

    EndIf

    Declare Ergebnis$,Maske&,GrpCnt%,HexStr$,Hexa%,ShiftCnt%
    Clear Ergebnis$,ShiftCnt%
    Maske& = $F
    GrpCnt% = Grp%
    HexStr$ = 0123456789ABCDEF

    While Laenge%

        Dec Laenge%
        Dec GrpCnt%
        Hexa% = If(ShiftCnt%,((Wert& & Maske&) >> (ShiftCnt% * 4)) + 1,(Wert& & Maske&) + 1)
        Ergebnis$ = Mid$(Hexstr$,Hexa%,1) + Ergebnis$

        If (GrpCnt% = 0) And (Laenge% > 0)

            Ergebnis$ = Chr$(32) + Ergebnis$
            GrpCnt% = Grp%

        EndIf

        Maske& = Maske& << 4
        Inc ShiftCnt%

    EndWhile

    Return Ergebnis$

EndProc

Init_CrcTab
Declare sum&,bereich#,text$
Cls
text$=Probestring. Man könnte auch einen Bereich angeben.
sum& = Crc32(addr(text$),Len(text$)) : Print $;MyHex$(sum&,8), == ,sum&
text$=Probestring. Man könnte auch einen Bereich angeben
sum& = Crc32(addr(text$),Len(text$)) : Print $;MyHex$(sum&,8), == ,sum&
text$= Probestring. Man könnte auch einen Bereich angeben.
sum& = Crc32(addr(text$),Len(text$)) : Print $;MyHex$(sum&,8), == ,sum&
text$=Probestring. Mbn könnte auch einen Bereich angeben.
sum& = Crc32(addr(text$),Len(text$)) : Print $;MyHex$(sum&,8), == ,sum&
text$=Probestring. Man könnte auch einen Bdreich angeben.
sum& = Crc32(addr(text$),Len(text$)) : Print $;MyHex$(sum&,8), == ,sum&
Print
Dim bereich#,1000004
Clear bereich#
sum& = Crc32(bereich#,1000000) : Print $;MyHex$(sum&,8), == ,sum&
Byte bereich#,100 = 1
sum& = Crc32(bereich#,1000000) : Print $;MyHex$(sum&,8), == ,sum&
Dispose bereich#
WaitKey
Fin