home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PC_DISK.ZIP / PC-DISK3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-10-10  |  5.1 KB  |  149 lines
  1. {$R+}
  2. program pcdisk3;
  3.  
  4. type
  5.      filename                 = string[11];
  6.      catalog_record           = record
  7.           volume_no           : integer;
  8.           file_name           : filename;
  9.           size1,size2         : integer;
  10.           time,date           : integer;
  11.           description         : string[33];
  12.           end;
  13.      index_record             = record
  14.           origin              : integer;
  15.           first_file          : integer;
  16.           last_file           : integer;
  17.           end;
  18.  
  19. var
  20.     datafilein                : file of catalog_record;
  21.     datafileout               : file of catalog_record;
  22.     cr                        : catalog_record;
  23.     size                      : real;
  24.     t1,t2,t3                  : integer;
  25.     d1,d2,d3                  : integer;
  26.     file_table                : array[1..200] of catalog_record;
  27.     file_count                : integer;
  28.     volume_table              : array[1..20] of catalog_record;
  29.     volume_index              : array[0..20] of index_record;
  30.     volume_count              : integer;
  31.     i, j                      : integer;
  32.     keyid                     : integer;
  33.     catfile,catfilex          : string[80];
  34.     line_count                : integer;
  35.     parm                      : string[80];
  36.     pagesize                  : integer;
  37.     view                      : boolean;
  38.     outfile                   : text;
  39.  
  40. function realsize(s1,s2    : integer) : real;
  41.  
  42. var
  43.      x                     : real;
  44.  
  45. begin;
  46.      if s1<0 then x := 65536.0+s1
  47.      else         x := s1;
  48.      x := x+65536.0*s2;
  49.      realsize := x;
  50.      end; { conversion from two integers to a real }
  51.  
  52. procedure sortvolume;
  53.  
  54. var
  55.      i, j, k                   : integer;
  56.      lowkey                    : filename;
  57.  
  58. begin
  59.      for i := 1 to volume_count-1 do begin
  60.           k := i;
  61.           lowkey := volume_table[i].file_name;
  62.           for j := i+1 to volume_count do begin
  63.                if lowkey>volume_table[j].file_name then begin
  64.                     k := j;
  65.                     lowkey := volume_table[j].file_name;
  66.                     end; { saving new low key and index }
  67.                end; { search for current lowest key and index }
  68.           if k<>i then begin
  69.                cr := volume_table[i];
  70.                volume_table[i] := volume_table[k];
  71.                volume_table[k] := cr;
  72.                volume_index[0] := volume_index[i];
  73.                volume_index[i] := volume_index[k];
  74.                volume_index[k] := volume_index[0];
  75.                end; { swap if current is not lowest }
  76.           end; { sorting the volume table, slowly }
  77. end; { volume sort procedure }
  78.  
  79. begin
  80.      catfile := 'C:\PUBLIC\COLLECT.DAT';
  81.      parm := ParamStr(1);
  82.      if length(parm)>0 then catfile := parm;
  83.      volume_count := 0;
  84.      file_count := 0;
  85.      assign(datafilein,catfile);
  86.  {$i-}
  87.      reset(datafilein);
  88.  {$i+}
  89.      if IOresult<>0 then begin
  90.           writeln('Unable to open ',catfile,'. Program halted');
  91.           halt;
  92.           end;
  93.      while(not eof(datafilein)) do begin
  94.           read(datafilein,cr);
  95.           if cr.volume_no=-1 then begin
  96.                volume_count := volume_count+1;
  97.                volume_table[volume_count] := cr;
  98.                with volume_index[volume_count] do begin
  99.                     origin := volume_count;
  100.                     first_file := 0;
  101.                     last_file := 0;
  102.                     end;
  103.                writeln(volume_count:2,'  ',cr.file_name);
  104.                end
  105.           else begin
  106.                file_count := file_count+1;
  107.                file_table[file_count] := cr;
  108.                if volume_index[volume_count].first_file=0 then
  109.                     volume_index[volume_count].first_file := file_count;
  110.                volume_index[volume_count].last_file := file_count;
  111.                end;
  112.           end;
  113.      writeln(file_count,' file records read.');
  114.      writeln(volume_count,' volume records read.');
  115.      close(datafilein);
  116.      sortvolume;
  117.      i := pos('.',catfile);
  118.      writeln('Period location ',i);
  119.      if i>0 then catfilex := copy(catfile,1,i-1)
  120.      else        catfilex := catfile;
  121.      assign(datafileout,catfilex+'.111');
  122.      {$I-} rewrite(datafileout); {$I+}
  123.      if IOresult<>0 then begin
  124.           {$I-} reset(datafileout); {$I+}
  125.           if IOresult<>0 then begin
  126.                writeln('Unable to open output temporary ',catfilex+'.111');
  127.                halt;
  128.                end;
  129.           end;
  130.      for i := 1 to volume_count do begin;
  131.           write(i,' ',volume_table[i].file_name,' ');
  132.           write(datafileout,volume_table[i]);
  133.           with volume_index[i] do begin
  134.                writeln(first_file:3,last_file:3);
  135.                for j := first_file to last_file do begin
  136.                     file_table[j].volume_no := i;
  137.                     write(datafileout,file_table[j]);
  138.                     end;
  139.                end;
  140.           end;
  141.      close(datafileout);
  142.      rename(datafilein,catfilex+'.bak');
  143.      rename(datafileout,catfile);
  144. end.
  145. 
  146.           end;
  147.      close(datafileout);
  148.      rename(datafilein,catfilex+'.bak');
  149.      r