home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SHDK_2.ZIP / SHCRCCHK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-30  |  7.8 KB  |  214 lines
  1. {$I SHDEFINE.INC}
  2.  
  3. {$I SHUNITSW.INC}
  4.  
  5. {$D-,L-}
  6. {$A-}
  7. unit ShCrcChk;
  8. {
  9.                                 ShCrcChk
  10.  
  11.                      A File CRC16 Calculation Unit
  12.  
  13.                                    by
  14.  
  15.                               Bill Madison
  16.  
  17.                    W. G. Madison and Associates, Ltd.
  18.                           13819 Shavano Downs
  19.                             P.O. Box 780956
  20.                        San Antonio, TX 78278-0956
  21.                              (512)492-2777
  22.                              CIS 73240,342
  23.  
  24.                   Copyright 1991 Madison & Associates
  25.                           All Rights Reserved
  26.  
  27.         This file may  be used and distributed  only in accord-
  28.         ance with the provisions described on the title page of
  29.                   the accompanying documentation file
  30.                               SKYHAWK.DOC
  31. }
  32.  
  33. Interface
  34.  
  35. Uses
  36.   DOS;
  37.  
  38. Function CrcCalc(FileName : String) : word;
  39. {
  40.       Calculates the CCITT asynch CRC16 value for file = FileName.
  41. }
  42.  
  43. Function CrcCopy(InFileName, OutFileName : String) : word;
  44. {
  45.       Calculates the CCITT asynch CRC16 value for file=InFileName. If
  46. OutFileName is specified, InFileName is copied to OutFileName. In either
  47. case, the CRC16 value is returned.
  48. }
  49.  
  50. Implementation
  51.  
  52. var
  53.     Buff   : array[1..16384] of Byte;  {The data buffer}
  54.               {Note: Extensive testing has determined that only a slight
  55.                speed-up can be achieved by increasing the buffer size
  56.                further. }
  57.  
  58. const
  59.   CrcTab : array[0..255] of Word =
  60.     ($0000,$1021,$2042,$3063,$4084,$50A5,$60C6,$70E7,
  61.      $8108,$9129,$A14A,$B16B,$C18C,$D1AD,$E1CE,$F1EF,
  62.      $1231,$0210,$3273,$2252,$52B5,$4294,$72F7,$62D6,
  63.      $9339,$8318,$B37B,$A35A,$D3BD,$C39C,$F3FF,$E3DE,
  64.      $2462,$3443,$0420,$1401,$64E6,$74C7,$44A4,$5485,
  65.      $A56A,$B54B,$8528,$9509,$E5EE,$F5CF,$C5AC,$D58D,
  66.      $3653,$2672,$1611,$0630,$76D7,$66F6,$5695,$46B4,
  67.      $B75B,$A77A,$9719,$8738,$F7DF,$E7FE,$D79D,$C7BC,
  68.      $48C4,$58E5,$6886,$78A7,$0840,$1861,$2802,$3823,
  69.      $C9CC,$D9ED,$E98E,$F9AF,$8948,$9969,$A90A,$B92B,
  70.      $5AF5,$4AD4,$7AB7,$6A96,$1A71,$0A50,$3A33,$2A12,
  71.      $DBFD,$CBDC,$FBBF,$EB9E,$9B79,$8B58,$BB3B,$AB1A,
  72.      $6CA6,$7C87,$4CE4,$5CC5,$2C22,$3C03,$0C60,$1C41,
  73.      $EDAE,$FD8F,$CDEC,$DDCD,$AD2A,$BD0B,$8D68,$9D49,
  74.      $7E97,$6EB6,$5ED5,$4EF4,$3E13,$2E32,$1E51,$0E70,
  75.      $FF9F,$EFBE,$DFDD,$CFFC,$BF1B,$AF3A,$9F59,$8F78,
  76.      $9188,$81A9,$B1CA,$A1EB,$D10C,$C12D,$F14E,$E16F,
  77.      $1080,$00A1,$30C2,$20E3,$5004,$4025,$7046,$6067,
  78.      $83B9,$9398,$A3FB,$B3DA,$C33D,$D31C,$E37F,$F35E,
  79.      $02B1,$1290,$22F3,$32D2,$4235,$5214,$6277,$7256,
  80.      $B5EA,$A5CB,$95A8,$8589,$F56E,$E54F,$D52C,$C50D,
  81.      $34E2,$24C3,$14A0,$0481,$7466,$6447,$5424,$4405,
  82.      $A7DB,$B7FA,$8799,$97B8,$E75F,$F77E,$C71D,$D73C,
  83.      $26D3,$36F2,$0691,$16B0,$6657,$7676,$4615,$5634,
  84.      $D94C,$C96D,$F90E,$E92F,$99C8,$89E9,$B98A,$A9AB,
  85.      $5844,$4865,$7806,$6827,$18C0,$08E1,$3882,$28A3,
  86.      $CB7D,$DB5C,$EB3F,$FB1E,$8BF9,$9BD8,$ABBB,$BB9A,
  87.      $4A75,$5A54,$6A37,$7A16,$0AF1,$1AD0,$2AB3,$3A92,
  88.      $FD2E,$ED0F,$DD6C,$CD4D,$BDAA,$AD8B,$9DE8,$8DC9,
  89.      $7C26,$6C07,$5C64,$4C45,$3CA2,$2C83,$1CE0,$0CC1,
  90.      $EF1F,$FF3E,$CF5D,$DF7C,$AF9B,$BFBA,$8FD9,$9FF8,
  91.      $6E17,$7E36,$4E55,$5E74,$2E93,$3EB2,$0ED1,$1EF0);
  92.  
  93. Function CRCResult(Var Table, Buffer; CrcVal, count : integer) : integer;
  94. var temp : integer;
  95. begin
  96. Inline(
  97.  {For I := 1 to Full do
  98.    CRCval := Crctab[hi(CRCval) xor Buff[I]] xor (lo(CRCval) shl 8);}
  99.   $1E/             {   push ds              ;save ds}
  100.   $06/             {   push es              ;save es}
  101.   $C5/$B6/>TABLE/  {   lds si, [bp+>Table]  ;ds:si points to the table}
  102.   $C4/$BE/>BUFFER/ {   les di, [bp+>buffer] ;es:si points to the buffer}
  103.   $8B/$8E/>COUNT/  {   mov cx,[bp+>count]   ;cx has the buffer size}
  104.   $8B/$9E/>CRCVAL/ {   mov bx,[bp+>CRCVal]  ;bx = start CRC value}
  105.   $E3/$25/         {   jcxz Done}
  106.   $89/$D8/         {   mov ax,bx            ;ax = start CRC value}
  107.                    { LooPit:}
  108.   $86/$C4/         {   xchg ah,al           ;al = hi byte}
  109.   $30/$E4/         {   xor ah,ah            ;ax = hi(CRCVal)}
  110.   $31/$D2/         {   xor dx,dx            ;dx = 0}
  111.   $26/             {   es:}
  112.   $8A/$15/         {   mov dl,[di]          ;dx = buffer[i] A BYTE value!!}
  113.   $47/             {   inc di               ;bump di (inc(i))}
  114.   $31/$D0/         {   xor ax,dx            ;ax = hi(CRCVal) xor Buffer[i]}
  115.   $89/$DA/         {   mov dx,bx            ;dx = CRCVal}
  116.   $89/$C3/         {   mov bx,ax            ;bx = hi(CRCVal) xor Buffer[i]}
  117.   $30/$F6/         {   xor dh,dh            ;dx = lo(CRCVal)}
  118.   $51/             {   push cx              ;save counter}
  119.   $B1/$08/         {   mov cl,8             ;need 8 shifts}
  120.   $D3/$E2/         {   shl dx,cl            ;dx = lo(CRCVal) shl 8}
  121.   $59/             {   pop cx               ;restore the counter}
  122.   $D1/$E3/         {   shl bx,1             ;need to mult by 2}
  123.   $3E/             {   ds:}
  124.   $8B/$00/         {   mov ax,[bx+si] ;ax = CRCTAbl[hi(CRCVal xor Buffer[i]]}
  125.   $31/$D0/         {   xor ax,dx      ;ax = CRCTab[hi(CRCVal) xor Buffer[i]]}
  126.                    {                        ;     xor (lo(CRCVal) shl 8)}
  127.   $89/$C3/         {   mov bx,ax            ;bx = new CRCVal}
  128.   $E2/$DD/         {   loop loopit          ;go do it all again}
  129.                    { Done:}
  130.   $89/$9E/>TEMP/   {   mov [bp+>temp],bx    ;bx has the final CRC value}
  131.   $07/             {   pop es               ;restore es}
  132.   $1F);            {   pop ds               ;restore ds}
  133.   CRCResult := temp{                        ;pass it back}
  134. end; {CrcResult}
  135.  
  136. Function CrcCalc(FileName : String) : word;
  137.   var
  138.     FI     : File;
  139.     Full   : Integer;     {How full is the buffer on a block read?}
  140.     CRCval : Integer;
  141.     FileAttr: word;
  142.  
  143.   begin  {CrcCalc}
  144.     CrcVal := 0;
  145.     Assign(FI, FileName);
  146.     GetFAttr(FI, FileAttr);
  147.     SetFAttr(FI, 0);     {can now open any file}
  148.     Reset(FI, 1);
  149.     repeat
  150.       BlockRead(FI, Buff, 16384, Full);
  151.       CrcVal := CrcResult(CrcTab, Buff, CrcVal, Full);
  152.       until Full <= 0;
  153.     Close(FI);
  154.     SetFAttr(FI, FileAttr);    {restore original filemode}
  155.     CrcCalc := CRCval;
  156.     end; {CrcCalc}
  157.  
  158. Function CrcCopy(InFileName, OutFileName : String) : word;
  159. {
  160.       Calculates the CCITT asynch CRC16 value for file=InFileName. If
  161. OutFileName is specified, InFileName is copied to OutFileName. In either
  162. case, the CRC16 value is returned. The DateTime stamp of the input file
  163. is preserved.
  164. }
  165.  
  166.   var
  167.     FI,
  168.     FO     : File;
  169.     Full   : Integer;     {Number of bytes transferred in BlockRead}
  170.     T1     : Integer;
  171.     CRCval : Integer;
  172.     DTStamp: LongInt;
  173.     FileAttr: word;
  174.  
  175.   begin  {CrcCopy}
  176.     CrcVal := 0;
  177.     Assign(FI, InFileName);
  178.     GetFattr(FI, FileAttr);
  179.     SetFAttr(FI, 0);     {can now open any file}
  180.     Reset(FI, 1);
  181.     If OutFileName[0] > #0 then begin
  182.       Assign(FO, OutFileName);
  183.       {$I-}Rewrite(FO, 1);{$I+}
  184.       If IOresult <> 0 then begin
  185.         WriteLn;
  186.         WriteLn('Can''t open file ',OutFileName,'  Aborting...');
  187.         Halt(1);
  188.         end;
  189.       end;
  190.     repeat
  191.       BlockRead(FI, Buff, 16384, Full);
  192.       CrcVal := CrcResult(CrcTab, Buff, CrcVal, Full);
  193.       If (OutFileName[0] > #0) and (Full > 0) then
  194.         {$I-}BlockWrite(FO, Buff, Full);{$I+}
  195.       T1 := IOresult;
  196.       If T1 <> 0 then begin
  197.         WriteLn;
  198.         WriteLn('I/O error ',T1,' writing file. Aborting...');
  199.         Close(FO);
  200.         Erase(FO);
  201.         Halt(1);
  202.         end;
  203.       until Full <= 0;
  204.     GetFTime(FI, DTstamp);
  205.     Close(FI);
  206.     SetFAttr(FI, FileAttr);    {restore original filemode}
  207.     If OutFileName[0] > #0 then begin
  208.       SetFTime(FO, DTstamp);
  209.       Close(FO);
  210.       end;
  211.     CrcCopy := CRCval;
  212.     end; {CrcCopy}
  213.   end.
  214.