Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TROJAN_P/FILETEST.ARC/FILECRC.SRC

Text File | 1988-03-09 | 30.0 KB | 1,039 lines

{  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

   The polynomials can be represented by a binary number, where a 1
   indicates the inclusion of the power term in the polynomial.  Since
   the highest order term is always included, that term is not needed
   in specifying the polynomial, and usually is dropped.  In addition,
   the bits are specified from low-order to high-order.  For example,
   the polynomial CRC-12 can be represented in the following manner:

    Order                   0  1  2  3  4  5  6  7  8  9 10 11 12
    Term Included ?         Y  Y  Y  Y  N  N  N  N  N  N  N  Y  Y
    Binary Representation   1  1  1  1  0  0  0  0  0  0  0  1 (1)<-- DROPPED

   The binary and hex representations for the three polynomials are:

                   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 random 17-bit bursts (~99.997%) and
   also a large percentage of random 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.  Notice that some errors can be generated in
   nonrandom ways that can substantially reduce the chances of
   detecting errors.

   (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.02;
  Version_Date = '12 SEP 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('[e-mail] or [e-mail]');

  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.
\Rogue\Monster\
else
  echo "will not over write ./filecrc.pas"
fi
if `test ! -s ./compare.pas`
then
echo "writing ./compare.pas"
cat > ./compare.pas << '\Rogue\Monster\'

{   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.02;
  Version_Date = '12 SEP 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 }
  updatefile : TEXT; { file for writing names of updated 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

  if date2 <> 0 then
  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
  else
    get_time := '                      ';

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.
}

var
  filesize : real;

begin
  Update_file := Update_file + 1;
  Writeln (updatefile,this_directory + '\' + filename);
  With fileinfo[file_number] do
  Begin
    Write (updatefile,'Old Date: ',get_time(time_of_day,date));
    if lowsize < 0 then
      filesize := int(highsize)*65536.0 + 32768.0 + int(lowsize and $7FFF)
    else
      filesize := int(highsize)*65536.0 + int(lowsize);
    Writeln (updatefile,' Attr = ',attribute:3,
           ', Size = ',filesize:10:0,', CRC = ', CRC);
  End;
  Write (updatefile,'New 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 (updatefile,' Attr = ',attribute:3,
           ', Size = ',filesize:10:0,', CRC = ', CRC_value);
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('[e-mail] or [e-mail]');

  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');
  Assign(updatefile,'FILES$$$.UPD');
  Rewrite (updatefile);
  Writeln (updatefile,'Files that were updated on this disk');


  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);
  Close (updatefile);
  if update_file = 0 then Erase (updatefile);

  {  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.