home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB18.ZIP / ALLDIR.PAS next >
Encoding:
Pascal/Delphi Source File  |  1985-08-18  |  3.4 KB  |  190 lines
  1. program Dir1;
  2.  
  3. {This program displays the default directory. It works with MS-DOS
  4.  (or PC-DOS) versions 1 and 2. It assumes a screen 80 columns wide.}
  5.  
  6. Type
  7.   regpack = record
  8.               case integer of
  9.                 1: (ax,bx,cx,dx,bp,si,di,ds,es,flags: integer);
  10.                 2: (al,ah,bl,bh,c,ch,dl,dh         : byte)
  11.             end;
  12.  
  13.   fcbarray =    array[0..36] of char;
  14.  
  15. const
  16.    getdta =       $1a;
  17.    get1stdir =    $11;
  18.    getnextdir =   $12;
  19.    getdefdrv  =   $19;
  20.    setdefdrv  =   $e;
  21.    getfreespace = $36;
  22.  
  23. var
  24.    filestr,
  25.    filename:        string[14];
  26.    dfcb,
  27.    dta:            fcbarray;
  28.    disk:           char;
  29.    drivecnt,i,curdrv,origdrv:       integer;
  30.  
  31. procedure screenstop;
  32. begin
  33. gotoxy(1,25);
  34. write('Press any key to continue ');
  35. while keypressed = false do
  36.  begin end;
  37. end;
  38.  
  39. function Freespace(curdrive:char):real;
  40. var
  41.   regs:   regpack;
  42.   fr  :   real;
  43.  
  44. begin
  45.    with regs do
  46.    begin
  47.      dx := ord(curdrive)-64;
  48.      ah := getfreespace;
  49.      MsDos(regs);
  50.      fr := bx;
  51.      if ax > 0 then Freespace := fr * ax * cx
  52.      else Freespace := 0
  53.    end;
  54. end;
  55.  
  56. procedure CountDisks;
  57. var
  58.   regs:       regpack;
  59.  
  60. begin
  61.   with regs do
  62.   begin
  63.     ah:=getdefdrv;
  64.     MsDos(regs);
  65.     curdrv := al+1;
  66.     dl:=al;
  67.     ah:=setdefdrv;
  68.     MsDos(regs);
  69.     drivecnt:=al-1;
  70.   end;
  71. end;
  72.  
  73. procedure ResetDisks(diskquery:byte);
  74.  
  75. var
  76.    regs:      regpack;
  77.  
  78. begin
  79.   with regs do
  80.   begin
  81.    dl:=diskquery-1;
  82.    ah:=setdefdrv;
  83.    disk := char(64+diskquery);
  84.    MsDos(regs);
  85.   end;
  86. end;
  87.  
  88. procedure DTAcall;
  89.  
  90. var
  91.   regs:       regpack;
  92.  
  93. begin
  94.   with regs do begin
  95.     dta[1] :='N';
  96.     dta[2] :='o';
  97.     dta[3] :=' ';
  98.     dta[4] :='F';
  99.     dta[5] :='i';
  100.     dta[6] :='l';
  101.     dta[7] :='e';
  102.     dta[8] :='s';
  103.     dta[9] :='.';
  104.     dta[10] :='.';
  105.     dta[11] :='.';
  106.     ah := getdta;
  107.     ds := seg(dta);
  108.     dx := ofs(dta);
  109.     MsDos(regs)
  110.   end
  111. end; {DTAcall}
  112.  
  113. procedure Dircall(call: byte; var errflag: byte);
  114.  
  115. var
  116.   regs:       regpack;
  117.  
  118. begin
  119.   with regs do begin
  120.     ah := call;
  121.     cx := 0;
  122.     ds := seg(dfcb);
  123.     dx := ofs(dfcb);
  124.     MsDos(regs);
  125.     errflag:= al
  126.   end
  127. end; {dircall}
  128.  
  129. Procedure loaddir;
  130.  
  131. var
  132.    i,j,
  133.    err:    byte;
  134.  
  135. begin
  136.   j := 0;
  137.   writeln;
  138.   textbackground(15);
  139.   textcolor(0);
  140.   write('                                 DIRECTORY OF ',disk,'               ');
  141.   write(freespace(disk):6:0,' bytes free ');
  142.   textbackground(0);
  143.   textcolor(15);
  144.   dfcb[0]:= ^@;
  145.   for i:= 1 to 11 do dfcb[i]:= '?';
  146.   DTACall;
  147.   Dircall(get1stdir, err);
  148.   repeat
  149.     if j = 0 then begin
  150.       TextBackground(15);
  151.       Write(' ');
  152.       TextBackGround(0);
  153.     end;
  154.     filename:= '';
  155.     for i:= 1 to 8 do filename:= filename + dta[i];
  156.     filename:= filename + '.';
  157.     for i:= 9 to 11 do filename:= filename + dta[i];
  158.     if wherey>24 then
  159.     begin
  160.       screenstop;
  161.       clrscr;
  162.     end;
  163.     write(filename);
  164.     textbackground(15);
  165.     write(' ');
  166.     textbackground(0);
  167.     j := j+1;
  168.     if j = 6 then
  169.     begin
  170.       TextBackground(15);
  171.       Write(' ');
  172.       TextBackGround(0);
  173.       j := 0
  174.     end;
  175.     Dircall(getnextdir, err)
  176.   until err <> 0;
  177. end; {loaddir}
  178.  
  179. begin
  180. clrscr;
  181. CountDisks;
  182. origdrv := curdrv;
  183. for i:= 1 to drivecnt do
  184. begin
  185.   ResetDisks(i);
  186.   loaddir;
  187. end;
  188. screenstop;
  189. ResetDisks(origdrv);
  190. end.