home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PROCRC11.ZIP / PROCRC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-21  |  4.2 KB  |  188 lines
  1.  
  2. (*
  3.  * ProCRC - Quickly calculate and compare CRC's for a group of files.
  4.  *
  5.  * S.H.Smith, 26-sep-88
  6.  * Copyright 1988 Samuel H. Smith, All Rights Reserved
  7.  *
  8.  *)
  9.  
  10. {$r-,s-}
  11. {$L+,D+}
  12.  
  13. uses Crt,Dos,MdosIO;
  14.  
  15. const
  16.    version =   'ProCRC: Quick CRC Checker v1.1 11-21-88  (C)1988 S.H.Smith';
  17.    bufsize =   $4000;
  18.  
  19.    files:      integer = 0;
  20.    errors:     integer = 0;
  21.    update_crc: boolean = false;
  22.  
  23. type
  24.    filename = string[64];
  25.  
  26. var
  27.    stdout:     text;
  28.    buf:        array[1..bufsize] of byte;
  29.    sizes:      longint;
  30.  
  31. {$i \tinc\gettime.inc}
  32. {$I \tinc\CRC16.INC}
  33.  
  34. (* ------------------------------------------------------------ *)
  35. procedure usage;
  36. begin
  37. {$i-}
  38.    writeln(output,'This utility scans a list of files and verifies that');
  39.    writeln(output,'none have been modified.');
  40.    writeln(output);
  41.    writeln(output,'Usage: ProCRC CRCLIST       ;check crcs against CRCLIST');
  42.    writeln(output,'       ProCRC CRCLIST -u    ;update CRCLIST with current file crcs');
  43.    writeln(output);
  44.    writeln(output,'Example:');
  45.    writeln(output,'  where *.exe >file.lst         ;build list of files');
  46.    writeln(output,'  procrc file.lst -U >file.crc  ;add crcs to the list');
  47.    writeln(output,'  procrc file.crc               ;check all crcs and report changes');
  48. {$i+}
  49.    halt(99);
  50. end;
  51.  
  52.  
  53. (* ------------------------------------------------------------ *)
  54. function calculate_crc(name: filename): word;
  55. var
  56.    fd:   dos_handle;
  57.    i,n:  word;
  58.  
  59. begin
  60.    inc(files);
  61.  
  62.    fd := dos_open(name,open_read);
  63.    if fd = dos_error then
  64.    begin
  65.       {$i-} writeln(output,'Can''t open: ',name); {$i+}
  66.       calculate_crc := 0;
  67.       exit;
  68.    end;
  69.  
  70.    {$i-} write(output,name); {$i+}
  71.  
  72.    crc_out := 0;
  73.    n := dos_read(fd,buf,sizeof(buf));
  74.    while n <> 0 do
  75.    begin
  76.       if wherex < 79 then
  77.          {$i-} write(output,'+'); {$i+}
  78.  
  79.       crcstr(buf,n);
  80.       sizes := sizes + n;
  81.       n := dos_read(fd,buf,sizeof(buf));
  82.    end;
  83.  
  84.    {$i-} write(output,^M); {$i+}
  85.    clreol;
  86.  
  87.    dos_close(fd);
  88.    calculate_crc := crc_out;
  89. end;
  90.  
  91.  
  92. (* ------------------------------------------------------------ *)
  93. procedure report_crc(name: filename);
  94. var
  95.    crc:  word;
  96. begin
  97.    crc := calculate_crc(name);
  98.    writeln(stdout,name,' ',crc);
  99. end;
  100.  
  101.  
  102. (* ------------------------------------------------------------ *)
  103. procedure verify_crc(name: filename; ocrc: word);
  104. var
  105.    crc:  word;
  106. begin
  107.    crc := calculate_crc(name);
  108.    if crc <> ocrc then
  109.    begin
  110.       writeln(stdout,'*** Caution: ',name,' is different! ***');
  111.       writeln(stdout,'    Old crc=',ocrc,'  New crc=',crc,^G^G);
  112.       writeln(stdout);
  113.       inc(errors);
  114.    end;
  115. end;
  116.  
  117.  
  118. (* ------------------------------------------------------------ *)
  119. var
  120.    ifd:           text;
  121.    ifb:           array[1..2048] of char;
  122.    line:          string;
  123.    p:             integer;
  124.    ifn:           filename;
  125.    crc:           word;
  126.    time:          real;
  127.    speed:         real;
  128.  
  129. begin
  130.    assign(stdout,'');
  131.    rewrite(stdout);
  132.    {$i-} writeln(output); writeln(output,version); writeln(output); {$i+}
  133.  
  134.    if paramcount < 1 then
  135.       usage;
  136.  
  137.    assign(ifd,paramstr(1));
  138.    {$i-} reset(ifd); {$i+}
  139.    if ioresult <> 0 then
  140.    begin
  141.       {$i-} writeln(output,'Can''t open CRCLIST file: ',paramstr(1)); {$i+}
  142.       halt(99);
  143.    end;
  144.  
  145.    setTextBuf(ifd,ifb);
  146.    update_crc := (paramstr(2) = '-U') or (paramstr(2) = '-u');
  147.    time := get_time;
  148.    sizes := 0;
  149.  
  150.    while not eof(ifd) do
  151.    begin
  152.       readln(ifd,line);
  153.  
  154.       p := pos(' ',line);
  155.       if p > 0 then
  156.       begin
  157.          ifn := copy(line,1,p-1);
  158.          line := copy(line,p+1,10);
  159.          val(line,crc,p);
  160.       end
  161.       else
  162.       begin
  163.          ifn := line;
  164.          update_crc := true;
  165.       end;
  166.  
  167.       if update_crc then
  168.          report_crc(ifn)
  169.       else
  170.          verify_crc(ifn,crc);
  171.    end;
  172.  
  173.    close(ifd);
  174.    time := get_time - time;
  175.    if time = 0 then
  176.       time := 0.05;
  177.    speed := int(sizes) / time;
  178.  
  179.    {$i-}
  180.    writeln(output,files,' files, ',errors,' differences.');
  181.    writeln(output,time:0:1,' seconds, ',sizes div 1024,'k bytes, ',speed:0:0,' bytes/sec.');
  182.    {$i+}
  183.    close(stdout);
  184.    halt(errors);
  185. end.
  186.  
  187.  
  188.