home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TMODEM.ZIP / DIRECT.INC < prev    next >
Encoding:
Text File  |  1987-06-15  |  7.8 KB  |  226 lines
  1.  
  2.    type
  3.       Char80arr       = array [ 1..80 ] of Char;
  4.       String80        = string[ 80 ];
  5.  
  6. (****************************************************************************)
  7. (*                         GET DEFAULT DRIVE LETTER                         *)
  8. (****************************************************************************)
  9.    function
  10.       default_drive : char;
  11.    var
  12.       regs          : registerset;
  13.    begin
  14.       regs.AX := $1900;
  15.       msdos( regs );
  16.       default_drive := chr(ord('A')+lo(regs.AX));
  17.    end;
  18.  
  19. (****************************************************************************)
  20. (*                          CHANGE DEFAULT DRIVE                            *)
  21. (****************************************************************************)
  22.    procedure
  23.       change_drive(dr : char);
  24.    var
  25.       regs            : registerset;
  26.    begin
  27.       regs.AX := $0E00;
  28.       regs.DX := ord(upcase(dr)) - ord('A');
  29.       msdos( regs );
  30.    end;
  31.  
  32. (****************************************************************************)
  33. (*                          DISK SPACE AVAILABLE                            *)
  34. (****************************************************************************)
  35.    function
  36.       diskspace(dr : char) : integer;
  37.    var
  38.       regs         : registerset;
  39.       r            : real;
  40.    begin
  41.       regs.AX := $3600;
  42.       regs.DX := 1 + ord(upcase(dr)) - ord('A');
  43.       msdos( regs );
  44.       r := ((regs.AX * regs.CX * 1.0) * regs.BX);
  45.       diskspace := round( r / 1024.0);
  46.    end;
  47.  
  48. (****************************************************************************)
  49. (*                          DISK DIRECTORY LISTER                           *)
  50. (****************************************************************************)
  51.    procedure
  52.       dir_list;
  53.  
  54.    {$I-}
  55.  
  56.    var
  57.       DTA          : array [ 1..43 ] of Byte;
  58.       DTAseg,
  59.       DTAofs,
  60.       SetDTAseg,
  61.       SetDTAofs,
  62.       Error,
  63.       I, J,
  64.       Option       : Integer;
  65.       Regs         : registerset;
  66.       Buffer,
  67.       NamR         : String80;
  68.       curdir       : string80;
  69.       dn           : integer;
  70.       ch           : char;
  71.       Mask         : Char80arr;
  72.       horz_tab     : byte;
  73.  
  74. (****************************************************************************)
  75. (*  SetDTA resets the current DTA to the new address specified in the       *)
  76. (*  parameters 'SEGMENT' and 'OFFSET'.                                      *)
  77. (****************************************************************************)
  78.       procedure
  79.          SetDTA( Segment, Offset : Integer; var Error : Integer );
  80.       begin
  81.          Regs.AX := $1A00;
  82.          Regs.DS := Segment;
  83.          Regs.DX := Offset;
  84.          MSDos( Regs );
  85.          Error := Regs.AX and $FF;
  86.       end;
  87.  
  88. (****************************************************************************)
  89. (*  GetCurrentDTA is used to get the current Disk Transfer Area ( DTA )     *)
  90. (*  address.  A function code of $2F is stored in the high Byte of the AX   *)
  91. (*  register and a call to the predefined procedure MSDos is made.  This    *)
  92. (*  can also be accomplished by using the "Intr" procedure with the same    *)
  93. (*  register record and a $21 specification for the interrupt.              *)
  94. (****************************************************************************)
  95.       procedure
  96.           GetCurrentDTA( var Segment, Offset : Integer;
  97.                          var Error : Integer );
  98.       begin
  99.          Regs.AX := $2F00;
  100.          MSDos( Regs );
  101.          Segment := Regs.ES;
  102.          Offset := Regs.BX;
  103.          Error := Regs.AX and $FF;
  104.       end;
  105.  
  106. (****************************************************************************)
  107. (*  GetFirst gets the first directory entry of a particular file Mask.  The *)
  108. (*  Mask is passed as a parameter 'Mask'.                                   *)
  109. (****************************************************************************)
  110.       procedure
  111.          GetFirst( Mask : Char80arr; var NamR : String80;
  112.                    Segment, Offset : Integer; Option : Integer;
  113.                    var Error : Integer );
  114.       var
  115.          I : Integer;
  116.       begin
  117.          Error := 0;
  118.          Regs.AX := $4E00;
  119.          Regs.DS := Seg( Mask );
  120.          Regs.DX := Ofs( Mask );
  121.          Regs.CX := Option;
  122.          MSDos( Regs );
  123.          Error := Regs.AX and $FF;
  124.          I := 1;
  125.          repeat
  126.             NamR[ I ] := Chr( mem[ Segment : Offset + 29 + I ] );
  127.             I := I + 1;
  128.          until ( not ( NamR[ I - 1 ] in [ ' '..'~' ] ));
  129.          NamR[ 0 ] := Chr( I - 1 );
  130.       end;
  131.  
  132. (****************************************************************************)
  133. (*  GetNextEntry uses the first bytes of the DTA for the file Mask, and     *)
  134. (*  returns the next file entry on disk corresponding to the file Mask.     *)
  135. (****************************************************************************)
  136.       procedure
  137.          GetNextEntry( var NamR : String80; Segment, Offset : Integer;
  138.                        Option : Integer; var Error : Integer );
  139.       var
  140.          I : Integer;
  141.       begin
  142.          Error := 0;
  143.          Regs.AX := $4F00;
  144.          Regs.CX := Option;
  145.          MSDos( Regs );
  146.          Error := Regs.AX and $FF;
  147.          I := 1;
  148.          repeat
  149.             NamR[ I ] := Chr( mem[ Segment : Offset + 29 + I ] );
  150.             I := I + 1;
  151.          until ( not ( NamR[ I - 1 ] in [ ' '..'~' ] ));
  152.          NamR[ 0 ] := Chr( I - 1 );
  153.       end;
  154.  
  155. (****************************************************************************)
  156. (*                        LIST DIRECTORY OF DISK                            *)
  157. (****************************************************************************)
  158.    begin
  159.       mkwin(1,1,80,24,'Disk Directory');
  160.       horz_tab := 4;
  161.       for I := 1 to 21 do DTA[ I ] := 0;
  162.       for I := 1 to 80 do begin
  163.          Mask[ I ] := Chr( 0 );
  164.          NamR[ I ] := Chr( 0 );
  165.       end;
  166.       NamR[ 0 ] := Chr( 0 );
  167.       GetCurrentDTA( DTAseg, DTAofs, Error );
  168.       if ( Error <> 0 ) then begin
  169.          WriteLn( 'Unable to get current DTA' );
  170.          WriteLn( 'Program aborting.' );
  171.          Halt;
  172.       end;
  173.       SetDTAseg := Seg( DTA );
  174.       SetDTAofs := Ofs( DTA );
  175.       SetDTA( SetDTAseg, SetDTAofs, Error );
  176.       if ( Error <> 0 ) then begin
  177.          WriteLn( 'Cannot reset DTA' );
  178.          WriteLn( 'Program aborting.' );
  179.          Halt;
  180.       end;
  181.       Error := 0;
  182.       Buffer[ 0 ] := Chr( 0 );
  183.       Option:=16;
  184.       ch:=default_drive;
  185.       dn:=ord(ch)-ord('A')+1;
  186.       getdir(dn,curdir);
  187.       writeln('   Current Drive\Directory: ',curdir);
  188.       Write('                  Dir Mask: ' );
  189.       ReadLn( Buffer );
  190.       WriteLn;
  191.       if ( length( Buffer ) = 0 ) then
  192.          Buffer := '*.*';
  193.       for I := 1 to length( Buffer ) do
  194.          Mask[ I ] := Buffer[ I ];
  195.       GetFirst( Mask, NamR, SetDTAseg, SetDTAofs, Option, Error );
  196.       if ( Error = 0 ) then begin
  197.          gotoxy(horz_tab,wherey);
  198.          Write( NamR );
  199.          horz_tab := horz_tab + 15;
  200.       end
  201.       else
  202.          WriteLn( '   File ''', Buffer, ''' not found.' );
  203.       while ( Error = 0 ) do begin
  204.          GetNextEntry( NamR, SetDTAseg, SetDTAofs, Option, Error );
  205.          if ( Error = 0 ) then begin
  206.             gotoxy(horz_tab,wherey);
  207.             Write( NamR );
  208.             horz_tab := horz_tab + 15;
  209.             if horz_tab > 70 then begin
  210.                horz_tab := 4;
  211.                writeln;
  212.             end;
  213.          end;
  214.       end;
  215.       SetDTA( DTAseg, DTAofs, Error );
  216.       if horz_tab > 4 then
  217.          writeln;
  218.       writeln;
  219.       writeln('   Bytes Available: ',diskspace(ch),'k');
  220.       write('  ');
  221.       wait_for_key;
  222.       rmwin;
  223.    end;
  224.  
  225.    {$I+}
  226.