home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / arc_lbr / chkpak.arc / CHKPAK.PAS < prev    next >
Pascal/Delphi Source File  |  1988-10-07  |  4KB  |  202 lines
  1. (*
  2.  
  3.    Program   CHKPAK
  4.    Version   1.00
  5.    Author    Atkinson - Home Computer - 414-543-8929 - 154/666
  6.    Language  Turbo Pascal 4
  7.    Utilities Turbo Professional
  8.    Dos       PC-DOS 3.3
  9.    Purpose   To check integrity of archived files
  10.    Date      08/25/88
  11.    Disk      One file is written - \CHKPAK.LOG
  12.  
  13.    Note that \CHKPAK.LOG is not deleted by this program, it is
  14.    meant to be used at a later time by yourself.
  15.  
  16.    If you have multiple directories you wish to check, the CHKPAK.LOG
  17.    file is not deleted.  If it is present it is appended.
  18.  
  19.    History   10/06/88 Created program
  20.  
  21.    Usage: CHKPAK file
  22.  
  23.           Where file is desired .ARC
  24.  
  25.           Ex: *.*, *.ARC, A*.ARC AB*.ARC etc...
  26.  
  27. *)
  28.  
  29. {$B+}
  30. {$D-}
  31. {$F-}
  32. {$I-}
  33. {$L-}
  34. {$M 16000,0,100000}
  35. {$N-}
  36. {$R-}
  37. {$S-}
  38. {$T-}
  39. {$V+}
  40.  
  41. program chkpak;
  42. uses    dos, tpstring, tpdos, tpcrt, tpint;
  43.  
  44. const
  45.     inthandle = 15;
  46. var
  47.     exitsave        : pointer;
  48.     code,
  49.     loop            : integer;
  50.     default_drive,
  51.     startdir,
  52.     arcname,
  53.     comment,
  54.     fullname        : string;
  55.     ok : boolean;
  56.     errorfile,
  57.     arcsfound,
  58.     commentfile     : text;
  59.     attr            : word;
  60.     searchfor       : searchrec;
  61.  
  62. procedure new1b(bp : word); interrupt;
  63. var
  64.     regs : intregisters absolute bp;
  65. begin
  66.     chainint(regs, isr_array[inthandle].origaddr);
  67.     halt;
  68. end;
  69.  
  70. procedure findfirstarchive;
  71. begin
  72.     attr := $3f;
  73.     findfirst(forceextension(paramstr(1),'ARC'), attr, searchfor);
  74.     ok := doserror = 0;
  75.     if ok
  76.     then
  77.       begin
  78.         writeln(arcsfound, fullpathname(searchfor.name));
  79.       end;
  80. end;
  81.  
  82. procedure findrestarchive;
  83. label 100;
  84. begin
  85. 100:    findnext(searchfor);
  86.     ok := doserror = 0;
  87.     if ok
  88.     then
  89.       begin
  90.         writeln(arcsfound, fullpathname(searchfor.name));
  91.       end;
  92.     if ok then goto 100;
  93. end;
  94.  
  95. procedure logerror(name : string);
  96. begin
  97.     writeln;
  98.     writeln('Logging error...', #7);
  99.     append(errorfile);
  100.     writeln(errorfile, 'ERROR IN FILE - ', name);
  101.     close(errorfile);
  102. end;
  103.  
  104. procedure doarc;
  105. begin
  106.     reset(arcsfound);
  107.         while not eof(arcsfound) do
  108.     begin
  109.       readln(arcsfound, arcname);
  110.       restorevector(inthandle);
  111.           code := execdos(fullname + ' /T '+arcname, false, Nil);
  112.       if initvector($1b, inthandle, @new1b) then {};
  113.       if dosexitcode <> 0 then logerror(arcname);
  114.     end;
  115.     close(arcsfound);
  116. end;
  117.  
  118. procedure checkdos;
  119. begin
  120.     if dosversion < $0300
  121.     then
  122.       begin
  123.          writeln;
  124.          writeln('DOS 3.++ or higher needed to operate...');
  125.          halt;
  126.       end;
  127. end;
  128.  
  129. {$F+}
  130. procedure end_program;
  131. begin
  132.     erase(arcsfound);
  133.     writeln;
  134.     writeln('See \CHKPAK.LOG in your default drive root directory...');
  135.     chdir(default_drive);
  136.     chdir(startdir);
  137.     exitproc := exitsave;
  138. end;
  139. {$F-}
  140.  
  141. procedure setup;
  142. begin
  143.     exitsave := exitproc;
  144.     exitproc := @end_program;
  145.     if initvector($1b, inthandle, @new1b) then {};
  146.     getdir(0, startdir);
  147.     default_drive := defaultdrive + ':\';
  148.     ok := false;
  149.     chdir(justpathname(paramstr(1)));
  150.     assign(arcsfound, '\arcstodo.$$$');
  151.     rewrite(arcsfound);
  152.     findfirstarchive;
  153. end;
  154.  
  155. procedure main;
  156. begin
  157.     if paramcount <> 0
  158.     then
  159.       if existonpath('pkxarc.exe', fullname)
  160.       or existonpath('pkunpak.exe', fullname)
  161.       then
  162.         begin
  163.           if ok
  164.           then
  165.         begin
  166.           findrestarchive;
  167.           close(arcsfound);
  168.           assign(errorfile, default_drive+'CHKPAK.LOG');
  169.           reset(errorfile);
  170.           if ioresult <> 0 then rewrite(errorfile);
  171.           close(errorfile);
  172.            doarc
  173.         end
  174.           else
  175.                 begin
  176.           writeln;
  177.           writeln('No .ARC files to process...')
  178.         end
  179.         end
  180.       else
  181.         begin
  182.           writeln;
  183.               writeln('PKXARC or PKUNPAK not found on path...')
  184.         end
  185.         else
  186.       begin
  187.         writeln;
  188.         writeln('Usage:');
  189.         writeln;
  190.         writeln('CHKPAK file');
  191.         writeln;
  192.         writeln('Where file is desired .ARC');
  193.         writeln;
  194.         writeln('Ex: *.*, *.ARC, A*.ARC AB*.ARC etc...');
  195.       end;
  196. end;
  197.  
  198. begin
  199.     setup;
  200.     main;
  201. end.
  202.