Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/msdos/trojan_p/filetest.arc/FILEREAD.PAS

Pascal/Delphi Source File | 1988-03-13 | 16.3 KB | 571 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.  The CRC's are placed in a file (FILETEST.NEW) to be compared
  with the CRC's calculated at a previous time in the file FILETEST.OLD.
  The comparison is done with the program FILECOMP.PAS.

   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 FILEREAD;

Const
  BufSize = 192;  { Number of 128 byte sectors in the CRC buffer }
  Buffer_Length = 24576;  { BufSize * 128 = Length of the CRC buffer }
  Version = 3.00;
  Version_Date = '03/11/88';
  POLY = $8404;  {  CRC Polynomial Used  }

label
  allover;
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;
  test_file : text;
  test_total,i: integer;
  doit,all_done,diagnostics: boolean;
  test_files: array [1 .. 100] of string255;
  test_done: array [1 .. 100] of boolean;
  outfile : TEXT;
  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
        all_done := true;
        for i := 1 to test_total do
          if not test_done[i] then all_done := false;
        begin
          this_file := get_file;
          if diagnostics then
            write (current_directory,'\',this_file,':');
          doit := false;
          for i := 1 to test_total do
            if current_directory+'\'+this_file = test_files[i] then
              begin
              doit := true;
              test_done[i] := true;
              end;
          if doit then
            begin
            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);
            if diagnostics then writeln ('   *');
            end
            else
            if diagnostics then writeln (all_done);
        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;
        if diagnostics then
          Writeln(this_directory);
        if not all_done then directory(this_directory);
      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, main program  }

  {  root will have the current drive designation  }
  root := chr(current_drive + ord('A') - 1) + ':';
  diagnostics := false;
  assign (test_file,'FILETEST.FIL');
  {$I-}
  Reset (test_file);   {  See if FILETEST.FIL exists  }
  {$I+}
  if IOresult <> 0 then goto allover;
  test_total := 1;
  while not eof(test_file) do
    begin
    readln(test_file,test_files[test_total]);
    test_done[test_total] := false;
    if diagnostics then
      writeln(':',test_files[test_total],': ',test_total);
    if test_files[test_total] = 'C:\?' then
      begin
      test_total := test_total -1;
      diagnostics := true;
      Writeln('CRC file integrity program');
      Writeln('Version ',version:5:2,', ',version_date);
      Write('Written by Ted H. Emigh -- ');
      Writeln('[e-mail] or [e-mail]');
      Writeln('Modified by L. P. Levine -- University of Wisconsi-Milwaukee');
      end;
    test_total := test_total + 1;
    end;
  test_total := test_total - 1;
  Assign (filvar,'FILETEST.OLD');
  {$I-}
  Reset (filvar);   {  See if FILETEST.OLD exists  }
  {$I+}
  {  check_crc will be TRUE if FILETEST.OLD exists  }
  check_crc := (IOresult = 0);
  if check_crc then
  begin
    Assign (outfile,'FILETEST.NEW');
    if diagnostics then
      Writeln ('Creating File FILETEST.NEW');
  end
  else
  begin
    Assign (outfile,'FILETEST.OLD');
    if diagnostics then
      Writeln ('Creating File FILETEST.OLD');
  end;
  Close (filvar);
  Rewrite (outfile);  {  Open the output file  }

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

  if diagnostics then
    Writeln(root+'\');
  directory(root);  {  Now, do the CRC check  }
  if not all_done then
    begin
    writeln('Not all of the files you listed were found.');
    writeln;
    writeln ('Files not found:');
    for i := 1 to test_total do
      if not test_done[i] then writeln (test_files[i]);
    end;
  Close (outfile);
allover:
end.