home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / NEWPC_TP.ZIP / 2DIR.PAS next >
Encoding:
Pascal/Delphi Source File  |  1984-08-04  |  4.5 KB  |  157 lines
  1. Program test01;
  2. {$C-,V-,K-}        { to speed up turbo }
  3.  
  4. { types and vars req'd for disk space and dir procedures }
  5.  
  6. type
  7.   regpack      = record
  8.                    ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  9.                  end;
  10.   mem_ptr      = ^pointer_type;
  11.   pointer_type = array [1..2] of integer;
  12.   fname_type   = record
  13.                    name   : string[8];
  14.                    period : char;
  15.                    ext    : string[3];
  16.                  end;
  17.   dir_type     = array [1..122] of fname_type;
  18.  
  19. var
  20.   R            : regpack;
  21.   w,e,x        : integer;
  22.   pointer,dta  : mem_ptr;
  23.   asciiz       : string[32];  {string input for dir scan}
  24.   fname        : fname_type;
  25.   bts          : real;
  26.   directory    : dir_type;
  27.   total_files  : integer;
  28.  
  29. Procedure free_space(drive_letter : char);
  30. var
  31.   dl : integer;
  32. begin
  33.   drive_letter := upcase(drive_letter);
  34.   case drive_letter of
  35.     'A'..'E'  : dl := ord(drive_letter)-ord('A')+1;
  36.   else
  37.     dl := 0;
  38.   end;
  39.   R.ax :=$36 shl 8;          { disk free space }
  40.   R.dx := dl;
  41.   MsDos(R);
  42.   bts := r.bx; bts := bts * 1024;
  43.   write ('Diskdrive free space for ',drive_letter,':');
  44.   writeln (' ',r.bx,'k or ',bts:7:0,' bytes');
  45. end;
  46.  
  47. Procedure show_directory(current_dir : dir_type; Number_of_entries : integer);
  48. begin
  49.   writeln;
  50.   for x := 1 to 5 do write ('  Name   Ext    ');
  51.   for x := 1 to 76 do write('-'); writeln;
  52.   for x := 1 to number_of_entries do
  53.     begin
  54.       with current_dir[x] do write (name:8,period,ext:3);
  55.       write ('    ');
  56.     end;
  57.   writeln;
  58. end;
  59.  
  60. Procedure sort_directory (var current_dir : dir_type; num_entries : integer);
  61. var
  62.   nochange   : boolean;
  63.   temp1      : fname_type;
  64.  
  65. begin    {this is a cheap bubble sort... of sorts (bad pun!) }
  66.   write (' Sorting');
  67.   repeat
  68.     write ('.');
  69.     nochange := true;
  70.     for x := 1 to num_entries - 1 do
  71.       if current_dir[x].name > current_dir[x+1].name then
  72.         begin
  73.           temp1 := current_dir[x];
  74.           current_dir[x] := current_dir[x+1];
  75.           current_dir[x+1] := temp1;
  76.           nochange := false;
  77.         end
  78.       else
  79.         if current_dir[x].name = current_dir[x+1].name then
  80.           if current_dir[x].ext > current_dir[x+1].ext then
  81.             begin
  82.               temp1 := current_dir[x];
  83.               current_dir[x] := current_dir[x+1];
  84.               current_dir[x+1] := temp1;
  85.               nochange := false;
  86.             end;
  87.     num_entries := num_entries - 1;
  88.   until nochange;
  89.   writeln ('done ');
  90. end;
  91.  
  92.  
  93.    BEGIN {2DIR}
  94.   textcolor(lightcyan);
  95.   free_space('a');
  96.   free_space('b');
  97.   r.ax := 0;
  98.   r.es := 0;
  99.   r.bx := 0;
  100.   R.ax := $2F shl 8;         { Get DTA address in ES:BX }
  101.   MsDos(R);
  102.   dta := ptr(r.es,r.bx);
  103.   repeat
  104.     writeln;
  105.     total_files := 0;
  106.     write ('Enter DIR mask > ');
  107.     readln(asciiz);
  108.     if length(asciiz) = 0 then halt;
  109.     asciiz := asciiz + chr(00);
  110.     pointer := addr(asciiz[1]);
  111.     R.ds := seg(pointer^);
  112.     R.dx := ofs(pointer^);
  113.     R.cx := 0;
  114.     R.ax := $4E shl 8;   { get first entry in dir }
  115.     msdos(R);
  116.     begin
  117.      while (r.ax <> 18) and (r.ax <> 2) do
  118.        begin
  119.          total_files := total_files + 1;
  120.          e := 30;
  121.          fname.name := '';
  122.          fname.ext := '';
  123.          fname.period := ' ';
  124.          while (chr(mem[seg(dta^):ofs(dta^)+e]) <> '.') and (chr(mem[seg(dta^):ofs(dta^)+e]) <> #0) do
  125.            begin
  126.              fname.name := fname.name + chr(mem[seg(dta^):ofs(dta^)+e]);
  127.              e := e + 1;
  128.            end;
  129.            while length(fname.name) < 8 do fname.name := fname.name + ' ';
  130.            if chr(mem[seg(dta^):ofs(dta^)+e]) = '.' then
  131.              begin
  132.                fname.period := '.';
  133.                e := e + 1;
  134.                while chr(mem[seg(dta^):ofs(dta^)+e]) <> #0 do
  135.                  begin
  136.                    fname.ext := fname.ext + chr(mem[seg(dta^):ofs(dta^)+e]);
  137.                    e := e + 1;
  138.                  end;
  139.                while length(fname.ext) < 3 do fname.ext := fname.ext + ' ';
  140.              end;
  141.          directory[total_files] := fname;
  142.          R.ds := seg(pointer^);
  143.          R.dx := ofs(pointer^);
  144.          R.cx := 0;
  145.          R.ax := $4f shl 8;   { get first entry in dir }
  146.          msdos(R);
  147.        end;
  148.     end;
  149.   writeln;
  150.   sort_directory(directory,total_files);
  151.   show_directory(directory,total_files);
  152.   if total_files = 0 then
  153.     writeln ('Files not found.')
  154.   else
  155.     writeln ('Total files = ',total_files:3);
  156.   until asciiz = '';
  157. end.