Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/PC_DISK.ZIP/PC-DISK2.PAS

Pascal/Delphi Source File | 1985-10-10 | 9.9 KB | 291 lines

program pcdisk2;

const
     sectors_per_diskette     = 708;
     cluster_size             = 2;
     sector_size_bits         = 9;

type
     filename                 = string[11];
     catalog_record           = record
          volume_no           : integer;
          file_name           : filename;
          size1,size2         : integer;
          time,date           : integer;
          description         : string[33];
          end;

var
    datafile                  : file of catalog_record;
    cr                        : catalog_record;
    size                      : real;
    t1,t2,t3                  : integer;
    d1,d2,d3                  : integer;
    file_table                : array[1..1000] of catalog_record;
    file_count                : integer;
    file_sector_total         : integer;
    volume_table              : array[1..20] of filename;
    volume_count              : integer;
    volume_space_total        : real;
    volume_sector_total       : integer;
    i, j                      : integer;
    keyid                     : integer;
    catfile                   : string[80];
    line_count                : integer;
    parm                      : string[80];
    pagesize                  : integer;
    view                      : boolean;
    outfile                   : text;

function realsize(s1,s2    : integer) : real;

var
     x                     : real;

begin;
     if s1<0 then x := 65536.0+s1
     else         x := s1;
     x := x+65536.0*s2;
     realsize := x;
     end; { conversion from two integers to a real }

procedure sortfile;

var
     i, j, k                   : integer;
     lowkey                    : filename;

begin
     for i := 1 to file_count-1 do begin
          k := i;
          lowkey := file_table[i].file_name;
          for j := i+1 to file_count do begin
               if lowkey>file_table[j].file_name then begin
                    k := j;
                    lowkey := file_table[j].file_name;
                    end; { saving new low key and index }
               end; { search for current lowest key and index }
          if k<>i then begin
               cr := file_table[i];
               file_table[i] := file_table[k];
               file_table[k] := cr;
               end; { swap if current is not lowest }
          end; { sorting the file table, slowly }
end; { file sort procedure }

procedure sortvolume;

var
     i, j, k                   : integer;
     lowkey1                   : integer;
     lowkey2                   : filename;

begin
     for i := 1 to file_count-1 do begin
          k := i;
          lowkey1 := file_table[i].volume_no;
          lowkey2 := file_table[i].file_name;
          for j := i+1 to file_count do with file_table[j] do begin
               if ((lowkey1>volume_no) or
                  ((lowkey1=volume_no) and (lowkey2>file_name))) then begin
                    k := j;
                    lowkey1 := volume_no;
                    lowkey2 := file_name;
                    end; { saving new low key and index }
               end; { search for current lowest key and index }
          if k<>i then begin
               cr := file_table[i];
               file_table[i] := file_table[k];
               file_table[k] := cr;
               end; { swap if current is not lowest }
          end; { sorting the file table, slowly }
end; { volume sort procedure }

procedure sortsize;

var
     i, j, k                   : integer;
     lowkey, x                 : real;

begin
     for i := 1 to file_count-1 do begin
          k := i;
          lowkey := realsize(file_table[i].size1,file_table[i].size2);
          for j := i+1 to file_count do begin
               x := realsize(file_table[j].size1,file_table[j].size2);
               if lowkey>x then begin
                    k := j;
                    lowkey := x;
                    end; { saving new low key and index }
               end; { search for current lowest key and index }
          if k<>i then begin
               cr := file_table[i];
               file_table[i] := file_table[k];
               file_table[k] := cr;
               end; { swap if current is not lowest }
          end; { sorting the file table, slowly }
end; { size sort procedure }

procedure sortdate;

var
     i, j, k                   : integer;
     lowkey1                   : integer;
     lowkey2                   : integer;
     lowkey3                   : filename;

begin
     for i := 1 to file_count-1 do begin
          k := i;
          lowkey1 := file_table[i].date;
          lowkey2 := file_table[i].time;
          lowkey3 := file_table[i].file_name;
          for j := i+1 to file_count do with file_table[j] do begin
               if ((lowkey1>date) or
                  ((lowkey1=date) and (lowkey2>time)) or
                  ((lowkey1=date) and (lowkey2=time) and (lowkey3<file_name)))
                  then begin
                    k := j;
                    lowkey1 := date;
                    lowkey2 := time;
                    lowkey3 := file_name;
                    end; { saving new low key and index }
               end; { search for current lowest key and index }
          if k<>i then begin
               cr := file_table[i];
               file_table[i] := file_table[k];
               file_table[k] := cr;
               end; { swap if current is not lowest }
          end; { sorting the file table, slowly }
end; { volume sort procedure }

procedure pagebegin;

begin
     if view then clrscr else write(outfile,chr(12));
     writeln(outfile,'File name        Size   Date     Time   V# Description');
     if view then begin
          line_count := 2;
          end
     else begin
          writeln(outfile,' ');
          line_count := 3;
          end;
     end;

procedure pageend;

var
     junk           : string[10];

begin
     if view then begin
          gotoxy(1,24);
          writeln('Press enter to continue');
          readln(junk);
          end;
     pagebegin;
     end;

begin
     keyid := 5;
     view := true;
     catfile := 'C:\PUBLIC\COLLECT.DAT';
     for i := 1 to ParamCount do begin;
          parm := ParamStr(i);
          if parm[1]='/' then begin
               j := pos(upcase(parm[2]),'FVSDOMP');
               if j<6 then keyid := j
               else        view  := (j=6);
               end
          else                catfile := parm;
          end;
     line_count := 0;
     if view then begin
          pagesize := 24;
          assign(outfile,'CON:');
          clrscr;
          end
     else begin
          pagesize := 58;
          assign(outfile,'LST:');
          end;
     rewrite(outfile);
     volume_count := 0;
     volume_space_total := 0;
     volume_sector_total := 0;
     file_count := 0;
     assign(datafile,catfile);
 {$i-}
     reset(datafile);
 {$i+}
     if IOresult<>0 then begin
          writeln('Unable to open ',catfile,'. Program halted');
          halt;
          end;
     writeln(outfile,'Volume number/name cross reference');
     while(not eof(datafile)) do begin
          read(datafile,cr);
          if cr.volume_no=-1 then begin
               if volume_count>0 then begin
                    writeln(outfile,volume_space_total:9:0,
                          volume_sector_total:5,
                          sectors_per_diskette-volume_sector_total :5);
                    end;
               volume_count := volume_count+1;
               volume_table[volume_count] := cr.file_name;
               write(outfile,volume_count:2,'  ',cr.file_name,' ');
               volume_space_total := 0;
               volume_sector_total := 0;
               end
          else begin
               file_count := file_count+1;
               file_table[file_count] := cr;
               volume_space_total := volume_space_total +
                                     realsize(cr.size1,cr.size2);
               file_sector_total := (cr.size2 shl (16-sector_size_bits))+
                                    (cr.size1 shr sector_size_bits);
               if (cr.size1 shl (16-sector_size_bits))<>0 then
                    file_sector_total := file_sector_total+1;
               if (file_sector_total mod cluster_size)<>0 then
                    file_sector_total := (file_sector_total div cluster_size)*
                                         cluster_size+cluster_size;
               volume_sector_total := volume_sector_total+file_sector_total;
               end;
          end;
     writeln(outfile,volume_space_total:9:0,volume_sector_total:5,
                     sectors_per_diskette-volume_sector_total :5);
     writeln(outfile,file_count,' file records read.');
     writeln(outfile,volume_count,' volume records read.');
     case keyid of
          1 : sortfile;
          2 : sortvolume;
          3 : sortsize;
          4 : sortdate;
          5 : {sortno};
          else ;
          end;
     pageend;
     for i := 1 to file_count do begin;
          with file_table[i] do begin
               size := realsize(size1,size2);
               t3 := (time and 31)*2;
               t2 := (time shr 5) and 63;
               t1 := (time shr 11);
               d3 := date and 31;
               d2 := (date shr 5) and 15;
               d1 := (date shr 9) + 80;
               writeln(outfile,
                       copy(file_name,1,8),'.',copy(file_name,9,3),' ',
                       size:8:0,' ',
                       t1:2,':',t2:2,':',t3:2,' ',
                       d2:2,'/',d3:2,'/',d1:2,' ',
                       volume_no:2,' ',description);
               end;
          line_count := line_count+1;
          if line_count>=pagesize then pageend;
          end;
     close(datafile);
end.
    line_count := line_count+1;
          if line_count>=pagesize then pag