home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / PASCAL / DUMPING / CRC32.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-06  |  6.0 KB  |  158 lines
  1. Unit  CRC32 ;
  2.  
  3. {
  4.    Written 1995 by Oliver Fromme <fromme@rz.tu-clausthal.de>.
  5.    Donated to the public domain.  Freely usable, freely distributable.
  6.  
  7.    This unit provides a 32 bit CRC (cyclic redundancy check),
  8.    compatible with ZIP and Zmodem.
  9. }
  10.  
  11. {$A+,B-,I-,T-,V+,X+}
  12. {$D+,L+,Y+,R+,S+,Q+} {for debugging only}
  13.  
  14. {-$DEFINE NOASM} {Enable this DEFINE if you want to use Pascal routines
  15.                   instead of Assembly routines.}
  16.  
  17.  
  18.  
  19. Interface
  20.  
  21. Type  tCRC = LongInt ; {treated as unsigned 32 bit}
  22.  
  23. Procedure  InitCRC32 (Var CRC : tCRC) ;
  24.    {Initializes the given variable for CRC calculation.}
  25.  
  26. Procedure  UpdateCRC32 (Var CRC : tCRC ; Var InBuf ; InLen : Word) ;
  27.    {Updates the given CRC variable.  Checks 'InLen' bytes at 'InBuf'.}
  28.  
  29. Function  FinalCRC32 (CRC : tCRC) : tCRC ;
  30.    {Calculates the final CRC value of the given variable and returns it.
  31.     Note that the actual variable is not changed, so you can continue
  32.     updating it.}
  33.  
  34. {
  35.    Procedure  Example ;
  36.       Var  my_CRC : tCRC ;
  37.       Begin
  38.          InitCRC (my_CRC) ;
  39.          UpdateCRC32 (my_CRC,data1,SizeOf(data1) ;
  40.          UpdateCRC32 (my_CRC,data2,SizeOf(data2) ;
  41.          UpdateCRC32 (my_CRC,data3,SizeOf(data3) ;
  42.          tCRC := FinalCRC(my_CRC) ;
  43.          WriteLn ('CRC32 of data1-data3 is ',my_CRC)
  44.       End ;
  45. }
  46.  
  47.  
  48.  
  49. Implementation
  50.  
  51. {
  52.    The Polynomial being used ($edb88320):
  53.       x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x^1+x^0
  54.    The initial CRC value is -1, and the final CRC value is inverted.
  55.    This is compatible with CRCs used in ZIP and zmodem protocol.
  56. }
  57.  
  58. Const  CRC32Table : Array [0..255] Of LongInt = (
  59.    $00000000,$77073096,$ee0e612c,$990951ba,$076dc419,$706af48f,$e963a535,$9e6495a3,
  60.    $0edb8832,$79dcb8a4,$e0d5e91e,$97d2d988,$09b64c2b,$7eb17cbd,$e7b82d07,$90bf1d91,
  61.    $1db71064,$6ab020f2,$f3b97148,$84be41de,$1adad47d,$6ddde4eb,$f4d4b551,$83d385c7,
  62.    $136c9856,$646ba8c0,$fd62f97a,$8a65c9ec,$14015c4f,$63066cd9,$fa0f3d63,$8d080df5,
  63.    $3b6e20c8,$4c69105e,$d56041e4,$a2677172,$3c03e4d1,$4b04d447,$d20d85fd,$a50ab56b,
  64.    $35b5a8fa,$42b2986c,$dbbbc9d6,$acbcf940,$32d86ce3,$45df5c75,$dcd60dcf,$abd13d59,
  65.    $26d930ac,$51de003a,$c8d75180,$bfd06116,$21b4f4b5,$56b3c423,$cfba9599,$b8bda50f,
  66.    $2802b89e,$5f058808,$c60cd9b2,$b10be924,$2f6f7c87,$58684c11,$c1611dab,$b6662d3d,
  67.    $76dc4190,$01db7106,$98d220bc,$efd5102a,$71b18589,$06b6b51f,$9fbfe4a5,$e8b8d433,
  68.    $7807c9a2,$0f00f934,$9609a88e,$e10e9818,$7f6a0dbb,$086d3d2d,$91646c97,$e6635c01,
  69.    $6b6b51f4,$1c6c6162,$856530d8,$f262004e,$6c0695ed,$1b01a57b,$8208f4c1,$f50fc457,
  70.    $65b0d9c6,$12b7e950,$8bbeb8ea,$fcb9887c,$62dd1ddf,$15da2d49,$8cd37cf3,$fbd44c65,
  71.    $4db26158,$3ab551ce,$a3bc0074,$d4bb30e2,$4adfa541,$3dd895d7,$a4d1c46d,$d3d6f4fb,
  72.    $4369e96a,$346ed9fc,$ad678846,$da60b8d0,$44042d73,$33031de5,$aa0a4c5f,$dd0d7cc9,
  73.    $5005713c,$270241aa,$be0b1010,$c90c2086,$5768b525,$206f85b3,$b966d409,$ce61e49f,
  74.    $5edef90e,$29d9c998,$b0d09822,$c7d7a8b4,$59b33d17,$2eb40d81,$b7bd5c3b,$c0ba6cad,
  75.    $edb88320,$9abfb3b6,$03b6e20c,$74b1d29a,$ead54739,$9dd277af,$04db2615,$73dc1683,
  76.    $e3630b12,$94643b84,$0d6d6a3e,$7a6a5aa8,$e40ecf0b,$9309ff9d,$0a00ae27,$7d079eb1,
  77.    $f00f9344,$8708a3d2,$1e01f268,$6906c2fe,$f762575d,$806567cb,$196c3671,$6e6b06e7,
  78.    $fed41b76,$89d32be0,$10da7a5a,$67dd4acc,$f9b9df6f,$8ebeeff9,$17b7be43,$60b08ed5,
  79.    $d6d6a3e8,$a1d1937e,$38d8c2c4,$4fdff252,$d1bb67f1,$a6bc5767,$3fb506dd,$48b2364b,
  80.    $d80d2bda,$af0a1b4c,$36034af6,$41047a60,$df60efc3,$a867df55,$316e8eef,$4669be79,
  81.    $cb61b38c,$bc66831a,$256fd2a0,$5268e236,$cc0c7795,$bb0b4703,$220216b9,$5505262f,
  82.    $c5ba3bbe,$b2bd0b28,$2bb45a92,$5cb36a04,$c2d7ffa7,$b5d0cf31,$2cd99e8b,$5bdeae1d,
  83.    $9b64c2b0,$ec63f226,$756aa39c,$026d930a,$9c0906a9,$eb0e363f,$72076785,$05005713,
  84.    $95bf4a82,$e2b87a14,$7bb12bae,$0cb61b38,$92d28e9b,$e5d5be0d,$7cdcefb7,$0bdbdf21,
  85.    $86d3d2d4,$f1d4e242,$68ddb3f8,$1fda836e,$81be16cd,$f6b9265b,$6fb077e1,$18b74777,
  86.    $88085ae6,$ff0f6a70,$66063bca,$11010b5c,$8f659eff,$f862ae69,$616bffd3,$166ccf45,
  87.    $a00ae278,$d70dd2ee,$4e048354,$3903b3c2,$a7672661,$d06016f7,$4969474d,$3e6e77db,
  88.    $aed16a4a,$d9d65adc,$40df0b66,$37d83bf0,$a9bcae53,$debb9ec5,$47b2cf7f,$30b5ffe9,
  89.    $bdbdf21c,$cabac28a,$53b39330,$24b4a3a6,$bad03605,$cdd70693,$54de5729,$23d967bf,
  90.    $b3667a2e,$c4614ab8,$5d681b02,$2a6f2b94,$b40bbe37,$c30c8ea1,$5a05df1b,$2d02ef8d
  91. );
  92.  
  93. Procedure  InitCRC32 (Var CRC : tCRC) ;
  94.    Begin
  95.       CRC := -1 {=$ffffffff}
  96.    End {InitCRC32} ;
  97.  
  98. {$IFDEF NOASM}
  99.  
  100. Procedure  UpdateCRC32 (Var CRC : tCRC ; Var InBuf ; InLen : Word) ;
  101.    Var  BytePtr  : ^Byte ;
  102.         wcount   : Word ;
  103.         LocalCRC : tCRC ; {for faster access}
  104.    Begin
  105.       LocalCRC := CRC ;
  106.       BytePtr := Addr(InBuf) ;
  107.       For wcount:=1 To InLen Do Begin
  108.          LocalCRC := CRC32Table[Byte(LocalCRC XOr tCRC(BytePtr^))]
  109.                      XOr ((LocalCRC Shr 8) And $00ffffff) ;
  110.          Inc (BytePtr)
  111.       End ;
  112.       CRC := LocalCRC
  113.    End {UpdateCRC32} ;
  114.  
  115. {$ELSE}
  116.  
  117. Procedure  UpdateCRC32 (Var CRC : tCRC ; Var InBuf ; InLen : Word) ;
  118.    Assembler ;
  119.    Asm
  120.                 les     si,CRC
  121.                 mov     ax,es:[si]
  122.                 mov     dx,es:[si+2]
  123.                 les     si,InBuf
  124.                 mov     cx,inlen
  125.                 test    cx,cx
  126.                 jz      @skip
  127.  
  128.         @loop:  xor     bh,bh
  129.                 mov     bl,al
  130.                 seges lodsb
  131.                 xor     bl,al
  132.                 mov     al,ah
  133.                 mov     ah,dl
  134.                 mov     dl,dh
  135.                 xor     dh,dh
  136.                 shl     bx,2
  137.                 mov     di,word ptr [bx+CRC32Table]
  138.                 xor     ax,di
  139.                 mov     di,word ptr [bx+CRC32Table+2]
  140.                 xor     dx,di
  141.                 dec     cx
  142.                 jnz     @loop
  143.  
  144.                 les     si,CRC
  145.                 mov     es:[si],ax
  146.                 mov     es:[si+2],dx
  147.         @skip:
  148.    End {UpdateCRC32} ;
  149.  
  150. {$ENDIF}
  151.  
  152. Function  FinalCRC32 (CRC : tCRC) : tCRC ;
  153.    Begin
  154.       FinalCRC32 := Not CRC
  155.    End {FinalCRC32} ;
  156.  
  157. End.
  158.