Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!watmath!clyde!caip!topaz!ll-xn!mit-amt!mit-eddie!genrad!decvax!mcnc!ecsvax!emigh
From: emigh@ecsvax.UUCP (Ted Emigh)
Newsgroups: net.sources
Subject: MSDOS program to keep track of CRC's of files on a disk
Message-ID: <1933@ecsvax.UUCP>
Date: Fri, 15-Aug-86 14:25:26 EDT
Article-I.D.: ecsvax.1933
Posted: Fri Aug 15 14:25:26 1986
Date-Received: Sun, 17-Aug-86 10:30:34 EDT
Reply-To: emigh@ecsvax.UUCP (Ted Emigh)
Organization: NC State University
Lines: 1219


  The following is a pair of programs to calculate the CRC's of all the
files on a disk, and to compare this list to a previously generated list.
This allows you to keep track of files that have been added, deleted,
modified, or trashed.  The programs are written to be compiled under
TURBO Pascal (ver 3.0, although I haven't tried earlier versions).  See
the documentation for more information.  The three files this archive
will produce are : filecrc.doc, filecrc.pas, and compare.pas.
------------------------------CUT HERE----------------------------------
#-----------------------------------------------------------
#
#			filecrc.ar
# use 'sh filename.ar' to extract files from this archive
#
# Do not use csh.
#

echo "Extracting filecrc.doc <-- filecrc.ar"
cat << \===filecrc.doc=== > filecrc.doc






                                       FILECRC

                                   13 August 1986
                                    Ted H. Emigh


               FILECRC is a program to help detect when files have been
          corrupted.  FILECRC creates a list of all the files on the
          default drive along with creation date, file size, and a CRC
          (cyclic redundancy check) for each file.  When FILECRC is run
          again the new list is compared with the old list.  For any file,
          it is possible that:

          1)   The file is completely unchanged from the previous time.
               The file name (and directory entry) are the same at the two
               times, and it has not been modified.

          2)   The file has been modified in the normal manner, so that the
               directory entry has a new time of creation.  Files of this
               sort are counted, but no special treatment is given to them.

          3)   The file has been deleted in the time since the first time
               FILECRC was run.  Files of this sort are counted, but no
               special treatment is given to them.

          4)   A new file has appeared that was not on the disk at the time
               of the previous run of FILECRC.  Files of this sort are
               counted, and a list is placed in the file FILES$$$.NEW.
               While it is usual to find new files on the disk, this gives
               an easy way to keep track of what files are new, and where
               they are located.  This is important when using public
               domain programs to make sure they are not creating new files
               without you knowing about it.

          5)   The directory entry for a file is the same for both of the
               times the program was run, but the file was modified in some
               way.  This should not occur in normal practice, so the
               program writes a message to the terminal, and a list of
               these files is placed in the file FILES$$$.MOD.  This can
               occur when you use NORTON UTILITIES, or other such programs
               to modify the disk directly, bypassing the normal DOS
               handling of the files.  It also can happen when programs
               'run wild' (this is what prompted me to write this program
               in the first place).

               Running the program prior to each backup will assure you
          that you are not backing up files that have been corrupted.
          Also, in program development, running the program before and
          after a test run of your program can assure you that your program
          has not messed up the disk.



                                          1












                                   RUNNING FILECRC

               There are three files associated with FILECRC:
          FILECRC.COM -- The main program.
          COMPARE.CHN -- The comparison program overlay.
          COMPARE.COM -- A stand-alone version of the comparison program.

               FILECRC is run without command line parameters (although
          output redirection is permitted).  It will create CHECK$$$.NEW
          (or CHECK$$$.CRC if the file does not exist in the default
          directory), which is a list of all the files on the default disk
          in all directories.  FILECRC displays the directory names as it
          goes through them.  FILECRC will then call COMPARE, which will
          compare the files in CHECK$$$.NEW with those in CHECK$$$.CRC,
          noting any differences.  When COMPARE is finished, the old file
          list now will be called CHECK$$$.OLD, and the newly created one
          will be called CHECK$$$.CRC.

               COMPARE can be run as a stand alone program by typing

          COMPARE [NEWLIST.FIL [OLDLIST.FIL]]

               If NEWLIST.FIL is given, this will be used instead of
          CHECK$$$.NEW,and if given, OLDLIST.FIL will be used instead of
          CHECK$$$.CRC.  For example,
          COMPARE CHECK
          will check the file CHECK with CHECK$$$.CRC.  If NEWLIST.FIL is
          given, CHECK$$$.CRC will not be renamed.

               Any files created since the previous time FILECRC was run
          will be listed in the file FILES$$$.NEW, and any files that have
          been modified in a "NON DOS" manner will be listed in the file
          FILE$$$.MOD.




















                                          2












                                  PROGRAMMING NOTES


               FILECRC is written using Turbo Pascal, Version 3.0 for
          MSDOS.  It has been tested on an IBM PC/AT using DOS 3.10.  This
          program is not meant to represent the epitome of programming
          skill, but it works.  Any improvements and suggestions are
          welcome, particularly if you can improve the speed.  On my PC/AT
          with some 730 files occupying 18MB the program takes about 6
          minutes to complete.  I am convinced that FILECRC.COM cannot be
          improved significantly on speed (take that as a challenge,if you
          wish), but COMPARE.CHN and COMPARE.COM are relatively inefficient
          (but then of the 6 minutes, 5-1/2 minutes are spent in
          FILECRC.COM).  Programming notes in the programs are sparse, but
          I specifically set separate routines for handling each of the the
          file comparison types in COMPARE (use the procedures file_new,
          file_updated, file_OK, and bad_CRC if you would like to do
          something special for each file comparison type).

          FILECRC will work with any number of files or directories.  As
          written, COMPARE has a maximum of 200 directories and 1900 files
          with any number of files within any particular directory.  The
          maximum length of the directory name string is 64 characters.  I
          have used the program on subdirectories up to 10 levels deep
          without any problems.  These values for the number of directories
          and the number of files uses up just about as much memory as
          TURBO Pascal allows, so an increase in these numbers would
          necessitate a redesign of the program.

          Special thanks go to David Dantowitz of Digital Equipment
          Corporation (Dantowitz%eagle1.dec@decwrl) for providing the CRC
          routines (generate_table_256 and crc_string_256) and the routines
          for getting a directory (get_DTA, set_DTA, find_first, and
          find_next).  Of course, he takes no responsibility for the way I
          used his code.

          Ted H. Emigh
          Department of Genetics
          North Carolina State University
          Box 7614
          Raleigh, NC   27695-7614

          emigh@ecsvax.uucp
          NEMIGH@TUCC.BITNET









                                          3






===filecrc.doc===
# ----------
echo "Extracting filecrc.pas <-- filecrc.ar"
cat << \===filecrc.pas=== > filecrc.pas

{  PROGRAM TO CREATE OF FILE OF  THE CRC'S OF THE FILES ON THE DEFAULT DISK  }

{

  This program was written by Ted H. Emigh, and has been placed in the public
  domain, to be used at the user's discretion.  The CRC routines and the
  discussion of the CRC were written by David Dantowitz, Digital Equipment
  Corporation,  Dantowitz%eagle1.dec@decwrl.

  This program calculates the CRC (cyclic redundancy check) for all the files
  on the disk (with the exception of files that are hidden system files).  The
  CRC's are placed in a file (CHECK$$$.NEW) to be compared with the CRC's
  calculated at a previous time in the file CHECK$$$.CRC.  The comparison is
  done with the program COMPARE.PAS.  This program is set to automatically
  chain to COMPARE.PAS to automate the procedure, but this can be turned off
  by deleting the lines:
    Assign (chain_file,'COMPARE.CHN');
    Chain(chain_file);
  at the end of this program.


   For a good discussion of polynomial selection see "Cyclic
   Codes for Error Detection", by W. W. Peterson and
   D. T. Brown, Proceedings of the IEEE, volume 49, pp 228-235,
   January 1961.

   A reference on table driven CRC computation is "A Cyclic
   Redundancy Checking (CRC) Algorithm" by A. B. Marton and
   T. K. Frambs, The Honeywell Computer Journal, volume 5,
   number 3, 1971.

   Also used to prepare these examples was "Computer Networks",
   by Andrew S. Tanenbaum, Prentice Hall, Inc.  Englewood Cliffs,
   New Jersey, 1981.

   The following three polynomials are international standards:


        CRC-12 = X^12 + X^11 + X^3 + X^2 + X^1 + 1
        CRC-16 = X^16 + X^15 + X^2 + 1
        CRC-CCITT = X^16 + X^12 + X^5 + 1

   In Binary and hexadecimal :

                   Binary                     Hex

        CRC-12    = 1111 0000 0001           $0F01
        CRC-16    = 1010 0000 0000 0001      $A001
        CRC-CCITT = 1000 0100 0000 1000      $8404    (Used below)

   The first is used with 6-bit characters and the second two
   with 8-bit characters.  All of the above will detect any
   odd number of errors.  The second two will catch all 16-bit
   bursts, a high percentage of 17-bit bursts (~99.997%) and
   also a large percentage of 18-bit or larger bursts (~99.998%).
   The paper mentioned above (Peterson and Brown) discusses how 
   to compute the statistics presented which have been quoted 
   from Tanenbaum.

   (A burst of length N is defined a sequence of N bits, where
   the first and last bits are incorrect and the bits in the
   middle are any possible combination of correct and incorrect.
   See the paper by Peterson and Brown for more information)

}

{$G512,P512,U+,R+ }
Program FILECRC;

Const
  BufSize = 192;  { Number of 128 byte sectors in the CRC buffer }
  Buffer_Length = 24576;  { BufSize * 128 = Length of the CRC buffer }
  Version = 1.00;
  Version_Date = '13 AUG 86';
  POLY = $8404;  {  CRC Polynomial Used  }

Type
  Bytes = Array [1..24576] of Byte;  {  Length is 1..Buffer_Length  }

  Registers = record  {  Registers for 8088/8086/80286  }
                ax, bx, cx, dx, bp, si, di, ds, es, flags : integer;
              end;

  DTA_record = record  {  DTA as used by MSDOS  }
                 dos : array [1..21] of char;
                 attribute : byte;  {  Attribute byte  }
                 time_of_day : integer;  {  Time of Day of File Creation  }
                 date : integer;  {  Date of File Creation  }
                 low_size, high_size : integer;  {  Size of the File  }
                 filename: array [1..13] of char;  { File Name  }
                 junk : array [1..85] of byte;
               end;

  string255 = string[255];

Var
  {  Variables used in Calculating the CRC  }

  str_length, RecsRead, CRC_value : integer;
  table_256 : Array [0 .. 255] of Integer;  {CRC Table to speed computations}
  byte_string : Bytes;

  {  Variables used in setting up the input and output files  }

  filvar : file;
  chain_file : file;
  outfile : TEXT[$4000];
  check_crc : boolean;

  {  Misc. Variables  }

  root : string255;  {  Contains the default drive and root directory }
  global_reg : registers;  {  Registers for the DOS calls  }


Procedure generate_table_256(POLY : Integer);

{
    This routine computes the remainder values of 0 through 255 divided
  by the polynomial represented by POLY.  These values are placed in a
  table and used to compute the CRC of a block of data efficiently.
  More space is used, but the CRC computation will be faster.



    This implementation only permits polynomials up to degree 16.
}


Var
   val, i, result : Integer;

Begin
For val := 0 to 255 Do
  Begin
     result := val;
     For i := 1 to 8 Do
        Begin
           If (result and 1) = 1
              then result := (result shr 1) xor POLY
              else result :=  result shr 1;
        End;

     table_256[val] := result;
  End
End;


Function crc_string_256(Var s : Bytes; s_length, initial_crc : Integer)
                        : Integer;

{
     This routine computes the CRC value and returns it as the function
  value.  The routine takes an array of Bytes, a length and an initial
  value for the CRC.  The routine requires that a table of 256 values
  be set up by a previous call to Generate_table_256.

      This routine uses table_256.
}

Begin

inline(

$c4/$7e/<s/                {les di,s[bp]            (es:di points to array)  }
$8b/$46/<initial_crc/      {mov ax,initial_crc[bp]  (initial CRC value)      }
$8b/$4e/<s_length/         {mov cx,s_length[bp]     (count)                  }
$be/table_256/             {mov si,offset table_256 (table address)          }


{ next:  }

$26/$32/$05/               {xor al,es:[di]          CRC = CRC XOR next byte  }
$47/                       {inc di                  (point to next byte)     }

{ intermediate steps, see comments for overall effect }

$31/$db/                   {xor bx,bx               (bx <- 0)                }
$86/$d8/                   {xchg al,bl              (bx <- ax and 0FF)       }
$86/$e0/                   {xchg al,ah              (ax <- ax shr 8)         }
$d1/$e3/                   {shl bx,1                (bx <- bx+bx)            }

$33/$00/                   {xor ax,[bx+si]          CRC = (CRC shr 8) XOR
                                                          table[CRC and 0FF] }

$e2/$f0/                   {loop next               (count <- count -1)      }

$89/$46/<s+4);             {mov s+4[bp],ax          (crc_string_256 := CRC)  }


{  basic algorithm expressed above

crc := initial_crc

For each byte Do
Begin
  crc := crc XOR next_byte;
  crc := (crc shr 8) XOR table_256 [crc and $FF];
End;

crc_string_256 := crc;
}
End;



Procedure set_attr (attr : byte; asciiz : string255);
{

  This routine sets the file attributes.  Uses Function $43 in
  Interrupt $21.

  Turbo Pascal is unable to open and read various types files
  (e.g., r/o and files that are both hidden and system).  This
  gets around that by always setting the attribute to 0, then
  reseting it to the original value.

  attr  is the attribute to be set on the file
  asciiz is a string variable with the file name

}

begin
  asciiz := asciiz + chr(0);  {  Make a valid DOS ASCIIZ name  }
  {  Set up the registers for the interrupt  }
  global_reg.ax := $4301;
  global_reg.ds := seg(asciiz);
  global_reg.dx := ofs(asciiz)+1;
  global_reg.cx := attr;
  intr ($21, global_reg);
end;


Procedure get_crc(this_file : string255; dta : DTA_record);
{
  This procedure computes the CRC for a file.  Value is returned
  in the global variable CRC_value.

  this_file is a string variable containing the file name
  dta is a DTA_Record containing the file's DTA

}

var
  length  : real;  {  Length of the File  }

begin

  {  Change the Attribute byte so we can always open it  }
  {    To save some time, this is only done if the file  }
  {    Has any attribute other than ARCHIVE              }

  if (dta.attribute and $DF <> 0) then
    set_attr ( 0, this_file);

  {  Get the size of the file  }

  if dta.low_size < 0 then
    {  Negative low_size is really number between 32768 and 65536  }
    length := int(dta.high_size)*65536.0 + 32768.0
              + int(dta.low_size and $7FFF)
  else
    length := int(dta.high_size)*65536.0 + int(dta.low_size);

  {  Open the file as untyped  }

  Assign (Filvar, this_file);
  Reset (Filvar);

  {  Calculate the CRC  }

  CRC_value := 0;
  While length > 0.5 do
  Begin
    {  Read a segment of the file to process  }
    BlockRead(filvar,byte_string,BufSize,RecsRead);
    {  Get the correct number of bytes to process  }
    if length >= Buffer_Length then
      str_length := Buffer_Length
    else
      str_length := round(length);
    {  Compute the CRC  }
    CRC_value := crc_string_256(byte_string, str_length, CRC_value);
    {  Adjust the file length  }
    length := length - Buffer_Length;
  End;

  Close (Filvar);

  {  Restore the correct Attribute Byte  }
  if (dta.attribute and $DF <> 0) then
    set_attr ( dta.attribute, this_file);

end;


Procedure directory(current_directory : string255);

{
  Procedure to calculate the CRC of all the files in a directory,
  then all subdirectories in that directory

  current_directory contains the directory name (including drive)

}

var
  DTA_ofs, DTA_seg : integer;  {  Contains the current DTA address  }
  reg : Registers;  {  Local 8088/8086/80286 registers  }
  DTA : DTA_record;  {  Local DTA  }
  this_directory, this_file, asciiz : string255;  { directory and file names }


function get_file : string255;

{  Get the file name from the DTA  }

var
  i : integer;
  temp_file : string255;

begin
  i := 1;
  temp_file := '';
  repeat
    temp_file := temp_file + DTA.filename[i];
    i := i+1;
  until dta.filename[i] = chr(0);

  get_file := temp_file;

end;


function is_directory : boolean;

{  Function to tell if the file is a directory entry  }

begin
  is_directory := ((dta.attribute and $10) <> 0)
                   and (dta.filename[1] <> '.');
end;

Procedure set_DTA(offset, segment : integer);

{   sets the disk DTA
    Uses MSDOS Function $1A with interrupt $21
    offset is the offset of the new DTA
    segment is the segment of the new DTA
}

begin
  reg.ax := $1a00;
  reg.ds := segment;
  reg.dx := offset;
  intr($21, reg);
end;

Procedure get_DTA(var offset, segment : integer);

{   gets the disk DTA
    Uses MSDOS Function $2F with Interrupt $21
    offset will return with the current DTA offset
    segment will return with the current DTA segment
}

begin
  reg.ax := $2f00;
  intr($21, reg);
  offset := reg.bx;
  segment := reg.es;
end;


Function find_first (attr_mask : byte) : boolean;

{
    Find the first file matching the ASCIIZ string.
    attr_mask is $27 for files only and $37 for directories & files

    INT 21 function 4EH
    Returns TRUE if found, FALSE if not found
}

begin
  reg.ax := $4e00;
  reg.ds := seg(asciiz);
  reg.dx := ofs(asciiz)+1;
  reg.cx := attr_mask;
  intr($21, reg);
  find_first := (lo(reg.ax) <> 18);

end;


Function find_next (attr_mask : byte) : boolean;

{
    Find the next file matching the ASCIIZ string.
    attr_mask is $27 for files only and $37 for directories & files

    Returns TRUE if found, FALSE if not found
}

begin
  reg.ax := $4f00;
  reg.cx := attr_mask;
  intr($21, reg);
  find_next := (lo(reg.ax) <> 18);
end;


begin { directory }

  get_DTA(DTA_ofs, DTA_seg); { Save the current DTA location }

  set_DTA(ofs(DTA), seg(DTA)); { Set the DTA location to local area }

{
  Find and print the files in the current directory
}

  asciiz := current_directory + '\*.*' + CHR(0);  {  CHR(0) to make proper  }

{  Process all the files before doing any directories  }

  if find_first ($27) then
    repeat
      if dta.filename[1] <> '.' then
        begin
          this_file := get_file;
          get_crc(current_directory + '\' + this_file, dta);
          writeln(outfile,current_directory,' ',this_file,' ',
                dta. attribute,' ',dta.time_of_day,' ',dta.date,' ',
                dta.low_size,' ',dta.high_size,' ',CRC_value);
        end;
    until not find_next ($27);

{  Now process all the directories  }

  if find_first ($37) then
    repeat
      if is_directory then
      begin
        this_directory := current_directory + '\' + get_file;
        Writeln(this_directory);
        directory(this_directory);  {  Now do all subdirectories  }
      end;
    until not find_next ($37);

  set_dta(DTA_ofs, DTA_seg); { restore the old DTA }

end;


Function current_drive : byte;
{
  Function to return the current drive
  Uses MSDOS Function $19 with Interrupt $21
  current_drive is 1 if A, 2 if B, 3 if C, etc.

}

begin
  global_reg.ax := $1900;
  intr($21, global_reg);
  current_drive := 1 + lo(global_reg.ax);
end;


BEGIN  {  FILECRC  }

  {  root will have the current drive designation  }
  root := chr(current_drive + ord('A') - 1) + ':';

  Writeln('CRC file integrity program');
  Writeln('Version ',version:5:2,', ',version_date);
  Write('Written by Ted H. Emigh -- ');
  Writeln('emigh@ecsvax.uucp or NEMIGH@TUCC.BITNET');

  Assign (filvar,'CHECK$$$.CRC');
  {$I-}
  Reset (filvar);   {  See if CHECK$$$.CRC exists  }
  {$I+}
  {  check_crc will be TRUE if CHECK$$$.CRC exists  }
  check_crc := (IOresult = 0);
  if check_crc then
  begin
    Assign (outfile,'CHECK$$$.NEW');
    Writeln ('Creating File CHECK$$$.NEW');
  end
  else
  begin
    Assign (outfile,'CHECK$$$.CRC');
    Writeln ('Creating File CHECK$$$.CRC');
  end;
  Close (filvar);
  Rewrite (outfile);  {  Open the output file  }

  Generate_table_256(POLY);  {  Generate the table for CRC check  }

  Writeln(root+'\');
  directory(root);  {  Now, do the CRC check  }

  Close (outfile);

  { Now compare this with the previous CRC's  }

  if check_crc then
  begin
    Assign (chain_file,'COMPARE.CHN');
    Chain(chain_file);
  end;
end.
===filecrc.pas===
# ----------
echo "Extracting compare.pas <-- filecrc.ar"
cat << \===compare.pas=== > compare.pas

{   PROGRAM TO COMPARE THE CRC'S OF THE FILE LISTS IN  }
{   CHECK$$$.NEW AND CHECK$$$.CRC                      }

{$G512,P512,U+,R+ }
Program Compare;

TYPE
  string255 = string[255];
  string64 = string[64];
  string12 = string[12];

  Registers = record
                ax, bx, cx, dx, bp, si, di, ds, es, flags : integer;
              end;
  Months = array [1..12] of string[3];

  Directory_record = record
                       directory : string64;
                       FileNum   : integer;
                     end;

  File_Rec = record
               name                : string12;
               time_of_day, date   : integer;
               low_size,high_size  : integer;
               attribute           : byte;
               crc                 : integer;
             end;


CONST
  month : Months = ('JAN','FEB','MAR','APR','MAY','JUN',
                    'JUL','AUG','SEP','OCT','NOV','DEC');
  Version = 1.00;
  Version_Date = '13 AUG 86';

VAR

  {  File Creation time and date  }
  TimeOfDay, FileDate : integer;
  directory_number, file_number : integer;
  {  Number of files in each category  }
  old_file, new_file, OK_file, Update_file, Mod_file : integer;

  old_filename, new_filename : string64;
  infile : TEXT[$0800];  { file for reading file lists }
  newfile : TEXT; { file for writing names of new files created }
  modfile : TEXT; { file for writing names of modified files }
  tempfile : file; { used in renaming files }

  CRC_value : Integer;

  filename : string12;
  Name_of_File, CRC_string, instring : string255;

  attribute : byte;
  lowsize, highsize : integer;
  new, new_dir : boolean;

  number_directories, direct_count : integer;

  this_directory, current_directory : string64;

  directories : array [1..200] of directory_record;
  fileinfo : array [1..1900] of file_rec;


function get_string  : string255;
{
  This function returns a string up to the first space from infile
}
var
  inchar : char;
  temp_string : string255;

begin
  {  Ignore any leading blanks  }
  Repeat
    read(infile, inchar);
  Until inchar <> ' ';

  temp_string := '';

  {  Now, add on to temp_string until a blank is found  }
  Repeat
    temp_string := temp_string + inchar;
    read(infile, inchar);
  Until inchar = ' ';

  get_string := temp_string;

end;

procedure read_old_file;
{
  Procedure to read in the old list of files and set up the list of
  directories (variable directories), and the list of files along with
  the various data (variable fileinfo).
  On return,
  old_file has the number of files in the list and
  number_directories has the number of directories.

  The variables directories and fileinfo have the following information:
  directories  directory : Name of the directory (up to 64 characters)
               FileNum   : Number of the name in fileinfo that contains
                           the information for the first file in this
                           directory.

  fileinfo     name        : Name of the file
               time_of_day : Time of day in DOS format
               date        : Date in DOS format
               low_size    : Low byte of the file size
               high_size   : High byte of the file size
               attribute   : Attribute of the file
               crc         : CRC of the file

}

begin
  Reset (infile);  {  Set to read Old List of Files  }
  old_file := 0;  {  Number of files in the list  }
  number_directories := 0;  {  Number of directories in the list  }
  While not eof(infile) do
  begin
    old_file := old_file + 1;  {  Another file  }
    this_directory := get_string;  {  Get the directory name  }
    fileinfo[old_file].name := get_string;  {  Get the file name  }
    if this_directory <> current_directory then
    begin
      current_directory := this_directory;
      number_directories := number_directories + 1;
      directories[number_directories].directory := this_directory;
      directories[number_directories].FileNum := old_file;
    end;
    With fileinfo[old_file] do
      Readln(infile,attribute, Time_of_day, date, low_size, high_size, crc);
  end;
  directories[number_directories + 1].FileNum := old_file + 1;
  Close (infile);
end;


function get_time(date1,date2 : integer) : string64;
{
  This function returns the time and date of file creation.
  date1 is the time of day in DOS format
  date2 is the date of creation in DOS format

  get_time is a string with the time and date (e.g., 14:31:42  8 AUG 1986)
}

var
  hour, minute, second : integer;
  temp, time : string64;
  year, n_month, day : integer;

begin

  hour := date1 shr 11;
  minute := (date1 shr 5) - (hour shl 6);
  second := (date1 - (minute shl 5) - (hour shl 11))*2;
  year := date2 shr 9;
  n_month := (date2 shr 5) - (year shl 4);
  day := date2 - (n_month shl 5) - (year shl 9);
  Str(hour:2,temp);
  time := temp + ':';
  Str(minute:2,temp);
  time := time + temp + ':';
  Str(second:2,temp);
  time := time + temp + '   ';
  Str(day:2,temp);
  time := time + temp + ' ' + month[n_month] + ' ';
  Str(year + 1980:4,temp);
  get_time := time + temp;

end;

procedure write_old_file ( file_number : integer);
{
  Procedure to write the attribute, size and CRC for a file from
  the old list

  file_number is the number of the file name

}

var
  filesize : real;
begin
  with fileinfo[file_number] do
  begin
    if low_size < 0 then
      filesize := int(high_size)*65536.0 + 32768.0 + int(low_size and $7FFF)
    else
      filesize := int(high_size)*65536.0 + int(low_size);
    Write ('Attribute = ',attribute:3,', Size = ',filesize:10:0);
    Writeln(', CRC = ',CRC);
  end;
end;


procedure write_new_file;
{
  Procedure to write the attribute, size and CRC for a file from
  the new list

}

var
  filesize : real;
begin
  if lowsize < 0 then
    filesize := int(highsize)*65536.0 + 32768.0 + int(lowsize and $7FFF)
  else
    filesize := int(highsize)*65536.0 + int(lowsize);
  Write ('Attribute = ',attribute:3,', Size = ',filesize:10:0);
  Writeln(', CRC = ', CRC_value)
end;


procedure find_directory( var number : integer; var newdir : boolean);
{
  Procedure to the the directory from the old list that matches the
  directory name from the new list

  If the directory name is the same as the current directory, then
  number and newdir are unchanged.

  If the directory name is not the same, and it exists on the old list,
  number will be the number of the old directory, and newdir is FALSE.
  The current directory will be updated.

  If the directory name is not the same, and it does not exist on the
  old list, newdir is FALSE.  Number is number of directories + 1, but
  is never used.

}
begin
  {  If the directory is the same, then the status of number and newdir  }
  {  will not change                                                     }
  if this_directory <> current_directory then
  begin  {  search from the beginning  --  nothing fancy  }
    number := 0;
    Repeat
      number := number + 1;
    Until (number > number_directories) or
      (this_directory = directories[number].directory);
    newdir := (number > number_directories);
    current_directory := this_directory;
  end;
end;

procedure find_file( var number : integer; var new : boolean;
                    number_begin, number_end : integer);
{
  Procedure to find the file name.  The directory name has been
  found prior to this time, so the starting point in the search
  has been found.  The search will continue until the first file
   name in the next directory.

}
begin
  number := number_begin -1;
  Repeat
    number := number + 1;
  Until (number = number_end) or (filename = fileinfo[number].name);
  new := (filename <> fileinfo[number].name);
end;

procedure file_new;
{
  This procedure processes the new files.  new_file is the counter
  for the number of new files.  The file name and information is
  written to the file assigned to newfile.
}

var
  filesize : real;

begin
  new_file := new_file + 1;
  Write (newfile,this_directory+filename);
  Writeln (newfile,' Date: ',get_time(TimeOfDay, FileDate));
  if lowsize < 0 then
    filesize := int(highsize)*65536.0 + 32768.0 + int(lowsize and $7FFF)
  else
    filesize := int(highsize)*65536.0 + int(lowsize);
  Writeln (newfile,'Attribute = ',attribute:3,
           ', Size = ',filesize:10:0,', CRC = ', CRC_value);
end;

procedure file_updated;
{
  This procedure processes the updated files.  Update_file is the counter
  for the number of updated files.
}

begin
  Update_file := Update_file + 1;
end;

procedure file_OK;
{
  This procedure processes the files that have not been changed, modified
  or deleted.  OK_file is the counter for the number of such files.
}

begin
  OK_file := OK_file + 1;
end;

procedure bad_CRC;
{
  This procedure processes the files that have been modified without
  changing the directory entry date or time.  Mod_file is the counter for
  the number of such files.  In normal operations, this should not happen,
  so for such files, the name and date information is shown on the console
  and sent to the file assigned to modfile.
}

begin
  Mod_file := Mod_file + 1;
  Writeln ('CRC''s do not match!  File: ',this_directory+filename);
  Writeln ('Date: ',get_time(TimeOfDay, FileDate));
  Write ('Old file: ');
  write_old_file(file_number);
  Write ('New file: ');
  write_new_file;
  Write (modfile, this_directory + filename);
  Writeln (modfile,' Date: ', get_time(TimeOfDay, FileDate));
end;

procedure read_new_file;
{
  Procedure to read the list of new files, and compare them to the
  old files.  The various comparison types are processed according to
  the preceeding routines.
}

begin
  current_directory := '';
  new_dir := FALSE;

  Assign (infile, new_filename);
  Reset (infile);

  While not eof(infile) do
  begin
    this_directory := get_string;  {  First is the directory name  }
    filename := get_string;  {  Next is the file name  }
    Readln(infile, attribute, TimeOfDay, FileDate, lowsize,
           highsize, crc_value);  {  Then the file parameters  }
    {  Find the entry in the list of old files with the same name  }
    find_directory(directory_number,new_dir);
    if not new_dir then
      find_file(file_number,new,
                directories[directory_number].FileNum,
                directories[directory_number + 1].FileNum-1);
    if (new_dir or new) then  {  New directory means new file  }
      file_new
    else  {  Existing file, compare the two  }
      if (fileinfo[file_number].Time_of_day <> TimeOfDay)
        or (fileinfo[file_number].date <> FileDate) then
          file_updated
      else
        if (fileinfo[file_number].crc <> CRC_value) then bad_CRC
        else
          file_OK;
  end;
  Close (infile);
end;


BEGIN  {  Compare  }

  Writeln('CRC file integrity comparison program');
  Writeln('Version ',version:5:2,', ',version_date);
  Write('Written by Ted H. Emigh -- ');
  Writeln('emigh@ecsvax.uucp or NEMIGH@TUCC.BITNET');

  number_directories := 1;
  current_directory := '';
  directories[1].directory := current_directory;
  directories[1].FileNum := 1;

  {  Reset the counters for the various comparisons  }

  New_file := 0;
  OK_file := 0;
  Update_file := 0;
  Mod_file := 0;

  {  Set up the input and output files  }

  Case ParamCount of
    0 : begin  {  No command line parameters, use default names  }
          old_filename := 'CHECK$$$.CRC';
          new_filename := 'CHECK$$$.NEW';
        end;
    1 : begin  {  File name with listing of new files has been given  }
          old_filename := 'CHECK$$$.CRC';
          new_filename := ParamStr(1);
        end;
    else
        begin  {  Both file names have been given  }
          old_filename := ParamStr(2);
          new_filename := ParamStr(1);
        end;
  end;

  {  Set up the various input and output files  }

  Assign (infile,old_filename);
  Assign(newfile,'FILES$$$.NEW');
  Rewrite (newfile);
  Writeln (newfile,'New files created on this disk');
  Assign(modfile,'FILES$$$.MOD');
  Rewrite (modfile);
  Writeln (modfile,'Files that were modified without updating the directory');


  Writeln ('Reading old CRC list, please wait ...');
  read_old_file;

  Writeln ('Reading new CRC list and checking, please wait ...');
  read_new_file;

  {  Print the summary numbers for this check  }

  Writeln ('Number of Files in the last CRC check:           ',old_file);
  Writeln ('Number of Files that are the same as last time:  ',OK_file);
  Writeln ('Number of New Files:                             ',new_file);
  Writeln ('Number of Deleted Files:                         ',
            old_file - update_file - OK_file - Mod_file);
  Writeln ('Number of Updated Files:                         ',update_file);
  Writeln ('Number of Invalidly Modified Files:              ',Mod_file);
  Writeln;
  Writeln;


  {  Erase the output files if they are empty  }

  Close (newfile);
  if new_file = 0 then Erase (newfile);
  Close (modfile);
  if Mod_file = 0 then Erase (modfile);

  {  No command line parameters  --  Rename the files with the file lists  }

  if ParamCount = 0 then
  begin
    Assign (tempfile, 'CHECK$$$.OLD');
    {$I-}
    Reset (tempfile);  {  See if the file already exists  }
    {$I+}
    if IOresult =0 then
      Erase (tempfile);  {  Yes, it exists -- delete it  }
    Close (tempfile);
    Assign (tempfile, 'CHECK$$$.CRC');
    Rename (tempfile, 'CHECK$$$.OLD');
    Assign (tempfile, 'CHECK$$$.NEW');
    Rename (tempfile, 'CHECK$$$.CRC');
    Writeln ('Old CRC file is now CHECK$$$.OLD');
    Writeln ('New CRC file is now CHECK$$$.CRC');
    Writeln;
  end;



end.
===compare.pas===
# ----------
-- 

Ted H. Emigh     Genetics and Statistics, North Carolina State U, Raleigh  NC
USENET:	{akgua decvax duke ihnp4 unc}!mcnc!ecsvax!emigh
ARPA:	decvax!mcnc!ecsvax!emigh@BERKELEY
BITNET: NEMIGH@TUCC