Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/DEVICE2.ZIP/DEVICE.PAS

Pascal/Delphi Source File | 1984-01-01 | 9.7 KB | 314 lines

program Print_Device_Driver_Chain(input,output);
{*********************************************************************
 * DEVICE.PAS             program for displaying device driver chain *
 *                        for DOS 2.00,2.10,3.00,3.10                *
 *                                                                   *
 * by Tim MacNary         july 13,1985                               *
 *                        Turbo Pascal v. 2.00B PC-DOS               *
 *                                                                   *
 * Adapted from a Lattice C program by Stan Mitchell, published in   *
 * Dr. Dobb's Journal, #103 May, 1985, page 122.                     *
 * Please keep this comment here.                                    *
 *********************************************************************
    This routine uses fields of a standard FCB that Microsoft, in
 it's wisdom, declined to make public. Contained in each opened FCB
 are a Segment:Offset pair that point to the device drive used to
 access the opened file: if you open a disk file, then the driver
 interface to the disk drives is used; if the CON: device, then
 the console driver is used.
    DOS keeps track of the drivers by means of a linked list. Each
 driver has a header area which defines what that device can do, it's
 name, where it's entry points are, and the address of the next driver
 in the list. There is one special driver in the list: the NUL: device.
 It is always at the beginning of the list, so all other drivers will
 follow it.
     The routine is as follows:

begin
   Determine what DOS version being used
   Exit if the version = 0 ( means dos 1.xx )
   Initial an FCB with the NUL: device name.
   Open the file; exit if error.
   Get the pointers from the FCB; the pointers are in different places
     for DOS 2 and 3.
   Set up the screen --make it look nice
   Repeat
      Output the header
      Get the next header
   Until the next header offset field = $FFFF
   Output the last header
   Finish the screen display
end

}

const

   { DOS Function codes }
   OpenFCB  = $0F00;
   CloseFCB = $1000;
   DOS_Version  = $3000;

type
   DevHdr = record
      Next_Hdr_Offs,
      Next_Hdr_Seg,
      Attributes,
      Strategy,
      Interrupt:integer;
      Dev_Name:array[1..8] of char;
   end;

   DevHdr_Ptr = ^DevHdr;

   { The next two record types are used to access the pointers in
     the FCB }

   Reserve_V2 = record
      time: integer;
      attribute : byte;
      device_header_offset, device_header_segment: integer;
      Unknown : array[1..3] of byte;
   end;

   Reserve_V3 = record
      time: integer;
      attribute : integer;
      device_header_offset, device_header_segment: integer;
      Unknown : array[1..2] of byte;
   end;

   NameType = array[1..11] of char;

   FCB_Type = record
      drive:byte;
      fname:NameType;
      current_block :integer;
      record_size: integer;
      file_size: array[1..2] of integer;
      date: integer;
      RSU: array[1..10] of byte; { This is where the device pointer is stored }
      bset : array[1..5] of byte;
   end;


var
   device : DevHdr_Ptr;
   file_control_block : FCB_Type;
   rsv2_x: ^reserve_V2;
   rsv3_x: ^reserve_V3;
   Error:integer;
   Hdr_Seg,Hdr_Offs:integer;
   Version,Minor:integer;

procedure Init_FCB(Drive:byte;Name:NameType;var File_Control_Block:FCB_Type);

{ Fill in the Drive and File fields of the FCB.
  Returns an initialized File Control Block. }

begin
   File_Control_Block.Drive:=Drive;
   File_Control_Block.FName:=Name;
end; { Init_FCB }

procedure Open_Device(var File_Control_Block:FCB_Type;var Error:integer);

{ The equivalent of either a reset or a rewrite in Turbo Pascal }

var  Regs: record
             AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:integer;
          end;
begin
   Regs.DS:=SEG(File_Control_Block);
   Regs.DX:=OFS(File_Control_Block);
   Regs.AX:=OpenFCB;
   MSDOS(Regs);
   Error:=LO(Regs.AX);
end;

procedure Hex_Output(Value:integer);

{ Convert value to a hex string and output it, right-justified in a
  4 character field. }

var  Rem:integer;
     OutStr:string[4];
begin
   OutStr:='';

   repeat
      Rem:=Value MOD 16;     { Get remainder }
      Value:=Value DIV 16;   { calculate quotient }

      { Convert to A-F if necessary }
      if Rem > 9 then OutStr:=CHR(Rem + ORD('A') - 10 ) + OutStr
      else OutStr:=CHR(Rem + ORD('0')) + OutStr;
   until Value = 0;

   { Justify the answer a la Turbo }
   for Rem:=1 TO 4 - Length(OutStr) DO
      write(' ');
   write(OutStr);

end { Hex_Output };

procedure Print_Header(Dev:DevHdr_Ptr;Hdr_Seg,Hdr_Offs:integer);

{ Print a device driver header }

type Str4=string[4];
var  Co,Co2:integer;

procedure WriteIfEqual(Attributes,Mask:integer;Str:Str4;var Co:integer);

{ If an attribute is present, then print out a 4 character attribute indicator. }

begin
   if Attributes AND Mask <> 0 then
   begin
      write(Str);
      Co:=Co + 1
   end
end;

begin
   Co:=0;
   write('│ ');
   Hex_Output(Hdr_Seg);
   write('    │');
   Hex_Output(Hdr_Offs);
   write('   │ ');
   WITH Dev^ DO
   begin
      if (Attributes AND $8000) = 0000 then { Block device }
      begin
         write('# Blocks:');
         { write out block number}
         write(ORD(Dev_Name[1]):2);
         write(' │         ');
      end
      else begin
         WriteIfEqual(Attributes,$0001,'StI ',Co);
         WriteIfEqual(Attributes,$0002,'StO ',Co);
         WriteIfEqual(Attributes,$0004,'Nul ',Co);
         WriteIfEqual(Attributes,$0008,'Clk ',Co);
         WriteIfEqual(Attributes,$0010,'Spl ',Co);
         WriteIfEqual(Attributes,$4000,'IOC ',Co);
         for Co2 := 1 TO (3-Co) DO write('    ');
         write('│ ');
         for Co:=1 TO 8 DO write(Dev_Name[Co]); { Character device }
      end;
      write(' │');
      Hex_Output(Strategy);
      write('     │');
      Hex_Output(Interrupt);
      write('      │')
   end;
   writeln
end;

procedure Get_DOS_Version(var Major,Minor:integer);

{ Call MS-DOS to get the dos version number. The two returned values should
  be displayed: write(Major:1,'.',Minor:2);  Dos 1.xx will return a major
  version number of 0. }

var  Regs: record
             AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:integer;
          end;
begin
   Regs.AX:=DOS_Version;
   MSDOS(Regs);
   Major:=LO(Regs.AX);
   Minor:=HI(Regs.AX);
end;

procedure Set_Up_Screen(Version,Minor:integer);

{ Write out the column headers, etc }

begin
   write(  '                      ');
   TEXTCOLOR(BLACK);
   TEXTBACKGROUND(WHITE);
   writeln('╔═════════════════════╗');
   TEXTCOLOR(WHITE);
   TEXTBACKGROUND(BLACK);
   write(  '                      ');
   TEXTCOLOR(BLACK);
   TEXTBACKGROUND(WHITE);
   writeln('║ Device Driver Chain ║');
   writeln('╒═════════════════════╩═════════════════════╩═══════════════════╕');
   writeln('│ DOS Version ',Version:1,'.',Minor:2,'                                              │');
   writeln('├───────────────────────────────────────────────────────────────┤');
   writeln('│ Segment  Offset  Attributes    Name       Strategy  Interrupt │');
   writeln('├─────────┬───────┬─────────────┬──────────┬─────────┬──────────┤');
end; { Set_Up_Screen }

procedure Finish_Screen;
begin
   writeln('├─────────┴───────┴─────────────┴──────────┴─────────┴──────────┤');
   writeln('│ StI=Standard Input  StO=Standard Output  Nul=Nul Device       │');
   writeln('│ Spl=Special  Clk=Clock  IOC=Input/Output Control              │');
   writeln('└───────────────────────────────────────────────────────────────┘');
end; { Finish_Screen }

begin
   Get_DOS_Version(Version,Minor);
   if Version = 0 then { DOS 1.xx used }
   begin
      writeln('MS-DOS 2.xx or 3.xx required; exiting ...');
      repeat until KEYPRESSED;
      HALT
   end;

   { Get nul: header location by Opening it; the FCB has fields containing
     the SEG:OFS of the NUL device. }
   Init_FCB(0,'NUL        ',File_Control_Block);
   Open_Device(File_Control_Block,Error);

   if Error = 0 then   { Nul device opened successfully }
   begin
      case Version of { DOS 2.xx and 3.xx allocate the FCB differently }
         2: { DOS 2.xx }
            begin
               rsv2_x:=PTR(SEG(File_Control_Block),
                           OFS(File_Control_Block)+22);
               Device:=PTR(rsv2_x^.Device_Header_Segment,
                           rsv2_x^.Device_Header_Offset);
               Hdr_Seg :=rsv2_x^.Device_Header_Segment;
               Hdr_Offs:=rsv2_x^.Device_Header_Offset;
            end;
         3: { DOS 3.xx }
            begin
               rsv3_x:=PTR(SEG(File_Control_Block),
                           OFS(File_Control_Block)+22);
               Device:=PTR(rsv3_x^.Device_Header_Segment,
                           rsv3_x^.Device_Header_Offset);
               Hdr_Seg :=rsv3_x^.Device_Header_Segment;
               Hdr_Offs:=rsv3_x^.Device_Header_Offset;
            end;
         else begin
            writeln('DOS Version ',Version:2,'.',Minor:2,' not supported.');
            halt;
         end;
      end; { case }

      Set_Up_Screen(Version,Minor);
      repeat { loop down the device chain }
         Print_Header(Device,Hdr_Seg,Hdr_Offs);

         { Get next header location }
         Hdr_Seg:= Device^.Next_Hdr_Seg;
         Hdr_Offs:=Device^.Next_Hdr_Offs;

         Device:=PTR(Device^.Next_Hdr_Seg,Device^.Next_Hdr_Offs);
      until ( Device^.Next_Hdr_Offs = $FFFF );    { Until last Header }

      Print_Header(Device,Hdr_Seg,Hdr_Offs);
      Finish_Screen
   end
   else writeln('Error Opening Nul: device; error=',Error:1,'.');
   repeat until KeyPressed;
end.