home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SHDK_2.ZIP / TESTCRC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-05-14  |  3.0 KB  |  109 lines
  1. {$I SHDEFINE.INC}
  2.  
  3. {$I SHUNITSW.INC}
  4.  
  5. unit TestCrc;
  6. {
  7.                        To test the ShCrcChk unit
  8.  
  9.                   Copyright 1991 Madison & Associates
  10.                           All Rights Reserved
  11.  
  12.          This program source file and the associated executable
  13.          file may be  used and distributed  only in  accordance
  14.          with the  provisions  described  on  the title page of
  15.                   the accompanying documentation file
  16.                               SKYHAWK.DOC
  17. }
  18.  
  19. interface
  20.  
  21. uses
  22.   Dos,
  23.   ShCrcChk,
  24.   TpString,
  25.   TpCrt,
  26.   TpDos;
  27.  
  28. procedure CrcTest;
  29.  
  30. implementation
  31.  
  32. procedure CrcTest;
  33.  
  34. var
  35.   OriginalCRC,
  36.   CopiedFileCRC,
  37.   ChangedFileCRC: word;
  38.   XXX           : file of byte;
  39.   T1            : longint;
  40.   B1            : byte;
  41.   FF            : SearchRec;      {For the file to be checked}
  42.   FN            : string[12];     {   The name of the file}
  43.  
  44.   O             : text;
  45.  
  46. procedure AnyKey;
  47.   begin
  48.     if HandleIsConsole(1) then begin
  49.       Write(O, 'Any key to continue...');
  50.       if ReadKey = #0 then ;
  51.       WriteLn(O);
  52.       end;
  53.     end;
  54.  
  55. begin
  56.   if OpenStdDev(O, 1) then ;
  57.   FindFirst('*.*', $00, FF);
  58.   while (FF.Size < $FF)                   and
  59.         (JustExtension(FF.Name) = 'OVR')  and
  60.         (DosError = 0)                    do  FindNext(FF);
  61.   if FF.Size < $FF then begin
  62.     WriteLn(O, 'Couldn''t find a suitable file for checking. Aborting...');
  63.     exit;
  64.     end;
  65.   FN := FF.Name;
  66.   WriteLn(O, 'Reads file '+FN+' and calculates its CRC,');
  67.   WriteLn(O, 'makes a true copy and calculates its CRC, then makes a');
  68.   WriteLn(O, 'copy with one bit at or near the mid-point of the');
  69.   WriteLn(O, 'file changed and calculates its CRC. At the completion the');
  70.   WriteLn(O, 'three CRC''s are displayed.');
  71.   WriteLn(O, '');
  72.  
  73.   WriteLn(O, 'Copying with CrcCopy...');
  74.   OriginalCRC := CrcCopy(FN, ForceExtension(FN,'CK1'));
  75.   CopiedFileCRC := CrcCopy(ForceExtension(FN,'CK1'), 
  76.                            ForceExtension(FN,'CK2'));
  77.  
  78.   {Now change one bit in the second file, somewhere near the middle}
  79.   WriteLn(O, 'Changing one bit in the second copy...');
  80.   Assign(XXX, ForceExtension(FN,'CK2'));
  81.   Reset(XXX);
  82.   T1 := FileSize(XXX) shr 1;
  83.   Seek(XXX, T1);
  84.   Read(XXX,B1);
  85.   dec(T1);  {Put the pointer back where it belongs}
  86.   Write(O, '':5,'A $',HexB(B1),' is being changed to a ');
  87.   B1 := B1 xor $10;
  88.   WriteLn(O, '$',HexB(B1));
  89.   Seek(XXX, T1);
  90.   Write(XXX,B1);
  91.   Close(XXX);
  92.  
  93.   {Now calculate the CRC of the modified file.}
  94.   WriteLn(O, 'Calculating CRC of modified copy with CrcCalc...');
  95.   ChangedFileCRC := CrcCalc(ForceExtension(FN,'CK2'));
  96.  
  97.   {Tests completed. Display the result.}
  98.   WriteLn(O, 'CRC of original file = ',HexW(OriginalCRC));
  99.   WriteLn(O, 'CRC of true copy     = ',HexW(CopiedFileCRC));
  100.   WriteLn(O, 'CRC of changed copy  = ',HexW(ChangedFileCRC));
  101.   WriteLn(O);
  102.   AnyKey;
  103.   Erase(XXX);
  104.   Assign(XXX, ForceExtension(FN,'CK1'));
  105.   Erase(XXX);
  106.   Flush(O);
  107.   end; {CrcTest}
  108. end.
  109.