Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/LS.ZIP/LS.PAS

Pascal/Delphi Source File | 1985-12-28 | 6.4 KB | 280 lines

(*
 * ls - file list program
 *
 * this is a general file-list processing program
 * it can process a comma seperated list of wildcards
 * into a sorted pathname list
 *
 * shs 8/3/85
 *
 *)

program ls(output);


{$p512,d-}

const
   maxnumfiles =  250;
   null =         #0;

type
   longstring =   string [80];
   filestring =   string [15];
   filearray =    array [1.. maxnumfiles] of filestring;
   regpack =      record
                     ax,
                     bx,
                     cx,
                     dx,
                     bp,
                     si,
                     di,
                     ds,
                     es,
                     flags:         Integer;
                  end;


var
   reg:           regpack;
   dta:           longstring;
   filetable:     filearray;
   filesize:      array [1.. maxnumfiles] of integer;
   filecount:     integer;
   i,j,k:         integer;
   lines:         integer;
   pattern:       longstring;
   totalk:        integer;


procedure display_free_space(drive: longstring);
var
   cluster_size: real;

begin
   with reg do
   begin

      if drive[2] = ':' then
      begin
         write(drive[1],':  ');
         dx := ord(upcase(drive[1]))-ord('@');
      end

      else
         dx := 0;

      ax := $3600;
      msdos(reg);

      cluster_size := int(cx) * int(ax);
      write(int(bx) * cluster_size / 1024.0:0:0,'k or ');
      write(int(bx) / int(dx) * 100.0:0:2,'% free, out of ');
      writeln(int(dx) * cluster_size / 1024.0:0:0,'k total disk space');

   end;

end;


procedure sorttable(var fdir:     filearray;
                        first:     integer;
                        last:      integer);
var
   i:       integer;
   swapped: boolean;
   temp:    filestring;
   itemp:   integer;

begin

   repeat
      swapped := false;
      for i := first to last-1 do
      begin
         if fdir[i] > fdir[i+1] then
         begin
            temp := fdir[i];
            fdir[i] := fdir[i+1];
            fdir[i+1] := temp;
            itemp := filesize[i];
            filesize[i] := filesize[i+1];
            filesize[i+1] := itemp;
            swapped := true;
         end;
      end;

      last := last - 1;
   until (swapped = false) or (last < 2);

end;


procedure getfiles (patternlist:   longstring;
                         {comma seperated list of patterns to match}

                    fattr:         integer;
                         {attribute to match}

                    var fdir:      filearray;
                         {output filename list}

                    var num:       integer);
                         {output number of files}

{-find files matching specified characteristics}

var
   i,
   cf:            byte;
   onedir:        filestring;
   listpos:       integer;
   pattern:       longstring;
   c:             char;
   prevnum:       integer;
   h,d,y,m:       byte;

begin
   num := 0;
   totalk := 0;
   prevnum := 1;
   listpos := 1;

   while listpos <= length (patternlist) do
   begin
      pattern := '';
      c := patternlist [listpos];

      while (c <> ',') and (listpos <= length (patternlist)) do
      begin
         pattern := pattern + c;
         listpos := listpos + 1;
         c := patternlist [listpos];
      end;
      listpos := listpos + 1;

      if pattern[length(pattern)] = ':' then
         pattern := pattern + '*.*';

      display_free_space(pattern);

      pattern := pattern + null;
      reg.ax := $1a00;
      reg.ds := seg (dta [1]);
      reg.dx := ofs (dta [1]);
      msdos(reg);              {set dta address}

      reg.cx := fattr;
      reg.ax := $4e00;
      reg.ds := seg (pattern [1]);
      reg.dx := ofs (pattern [1]);
      msdos(reg);              {find first matching file}

      cf := reg.flags and 1;

      while ((cf <> 1) and (num < maxnumfiles)) do
      begin
         i := ord (dta [22]);

         if (i = fattr) or ((fattr <> 16) and
               (i < fattr)) then
         begin                       {get subdir or file name}

            onedir := '';
            i := 0;

            repeat
               c := dta [31 + i];
               if (c >= 'A') and (c <= 'Z') then
                  c := chr(ord(c) + 32);

               if c <> null then
                  onedir := onedir + c;

               i := i + 1;
            until c = null;          {throw out the . and .. entries}


            if onedir [1]<> '.' then
            begin
               num := num + 1;
               fdir[num]:= onedir;

               m:=Ord(dta[27]);
               h:=Ord(dta[28]);
               d:=Ord(dta[29]);
               y:=Ord(dta[30]);
               filesize[num] := trunc((m+256.0*(h+256.0*(d+256.0*y)))/1024.0+0.999);
               if (filesize[num] = 0) then
                  fdir[num] := ' ' + fdir[num]
               else
                  totalk := totalk + filesize[num];
            end;
         end;

         reg.ax := $4f00;
         reg.ds := seg (dta [1]);
         reg.dx := ofs (dta [1]);
         msdos(reg);              {keep searching for next file}

         cf := reg.flags and 1;
      end;

      sorttable(fdir,prevnum,num); {sort each part of list separately}
      prevnum := num + 1;
   end;

   if num >= maxnumfiles then
   begin
      writeln('warning: files in excess of ',
            maxnumfiles, ' ignored');
   end;
end;                     {getfiles}




begin

   if paramcount > 1 then
   begin
      writeln('usage: ls PATTERN{,PATTERN}');
      halt;
   end;

   if paramcount = 1 then
      pattern := paramstr(1)
   else
      pattern := '*.*';


   writeln;
   getfiles(pattern, $37, filetable, filecount);
   write('Total of ',totalk,'k used by ',filecount,' files in ');
   writeln(pattern);

   lines := ((filecount+3) div 4);
   for i := 1 to lines do
   begin
      k := i;
      for j := 1 to 4 do
      begin
         if k <= filecount then
         begin
            if filesize[k] > 0 then
               write(filesize[k]:3,'k ',filetable[k])
            else
               write(filetable[k],'\    ');

            if j <> 4 then
               write(' ':14-length(filetable[k]));
         end;
         k := k + lines;
      end;
      writeln;
   end;

   halt(0);
end.