World of Shareware - Software Farm 2/wosw_2.zip/wosw_2/PASCAL/TSRUTILS.ZIP/DEVICE.PAS

Pascal/Delphi Source File | 1989-05-04 | 12KB | 458 lines

{$R-,S-}

{
 Display the DOS device driver chain.
 Adapted from an assembly language program by Ray Duncan and modified by
 several others.
}

program Device_Chain;
uses
  Dos;

const
  Version = '2.9';                {Version number}
  MaxDevices = 100;               {Maximum number of devices to report}

  Digits : array[0..$F] of Char = '0123456789ABCDEF';

type
  {FCB used to find start of device driver chain}
  FileControlBlock =
    record
      Drive : Byte;
      Filename : array[1..8] of Char;
      Extension : array[1..3] of Char;
      CurrentBl : Word;
      LRL : Word;
      FilSizeLo : Word;
      FilSizeHi : Word;
      FileDate : Word;
      FileTime : Word;
      Other : array[0..7] of Byte;
      CurRecord : Byte;
      RelRecLo : Word;
      RelRecHi : Word;
    end;

  {Structure of a device driver header}
  DeviceHeader =
    record
      NextHeaderOffset : Word;    {Offset address of next device in chain}
      NextHeaderSegment : Word;   {Segment address of next device in chain}
      Attributes : Word;          {Device attributes}
      StrategyEntPt : Word;       {Offset in current segment - strategy}
      InterruptEntPt : Word;      {Offset in current segment - interrupt}
      DeviceName : array[1..8] of Char; {Name of the device}
    end;

  DisplayRec =
    record
      StartAddr : Pointer;
      Header : DeviceHeader;
    end;

  DeviceArray = array[1..MaxDevices] of DisplayRec;

  SO =
    record
      O, S : Word;
    end;

  SftRecPtr = ^SftRec;
  SftRec =
    record
      Next : SftRecPtr;
      Count : Word;
      Files : array[1..20] of FileRec;
    end;

  DosRec =
    record
      McbSeg : Word;
      FirstDPB : Pointer;
      FirstSFT : SftRecPtr;
      ClockDriver : Pointer;
      ConDriver : Pointer;
      MaxBlockBytes : Word;
      CachePtr : Pointer;
      DriveTable : Pointer;
      Unknown2 : Pointer;
      Unknown3 : Word;
      BlockDevices : Byte;
      LastDrive : Byte;
      NullDevice : DeviceHeader;
    end;
  DosRecPtr = ^DosRec;

var
  DeviceControlBlock : FileControlBlock; {File Control Block for NUL Device}
  Regs : Registers;               {Machine registers for MS-DOS calls}
  DevicePtr : ^DeviceHeader;      {Pointer to the next device header}
  DeviceSegment : Word;           {Current device segment}
  DeviceOffset : Word;            {Current device offset}
  DeviceCount : Word;             {Number of devices}
  Devices : DeviceArray;          {Sortable list of devices}
  RawMode : Boolean;

  procedure Abort(Msg : String);
  begin
    WriteLn(Msg);
    Halt(1);
  end;

  function HexB(B : Byte) : String;
    {-Return hex string for byte}
  begin
    HexB[0] := #2;
    HexB[1] := Digits[B shr 4];
    HexB[2] := Digits[B and $F];
  end;

  function HexW(W : Word) : String;
    {-Return hex string for word}
  begin
    HexW[0] := #4;
    HexW[1] := Digits[Hi(W) shr 4];
    HexW[2] := Digits[Hi(W) and $F];
    HexW[3] := Digits[Lo(W) shr 4];
    HexW[4] := Digits[Lo(W) and $F];
  end;

  function HexPtr(P : Pointer) : String;
    {-Return hex string for pointer}
  begin
    HexPtr := HexW(SO(P).S)+':'+HexW(SO(P).O);
  end;

  function FindNulDevice(Segm : Word) : Word;
    {-Return the offset of the null device in the specified segment}
  var
    Ofst : Word;
  begin
    for Ofst := 0 to 65534 do
      if MemW[Segm:Ofst] = $554E then
        {Starts with 'NU'}
        if Mem[Segm:Ofst+2] = Byte('L') then
          {Continues with 'L'}
          if (MemW[Segm:Ofst-6] and $801F) = $8004 then begin
            {Has correct driver attribute}
            FindNulDevice := Ofst-10;
            Exit;
          end;
    Abort('Cannot find NUL device driver');
  end;

var
  Pivot : DisplayRec;
  Swap : DisplayRec;

  function PhysAddr(X : Pointer) : LongInt;
    {-Return the physical address given by pointer X}
  begin
    PhysAddr := (LongInt(SO(X).S) shl 4)+SO(X).O;
  end;

  function Less(X, Y : DisplayRec) : Boolean;
    {-Return True if address of X is less than address of Y}
  begin
    Less := (PhysAddr(X.StartAddr) < PhysAddr(Y.StartAddr));
  end;

  procedure Sort(L, R : Word);
    {-Sort device headers}
  var
    I : Word;
    J : Word;
  begin
    I := L;
    J := R;
    Pivot := Devices[(L+R) shr 1];
    repeat
      {Sort by address}
      while Less(Devices[I], Pivot) do
        Inc(I);
      while Less(Pivot, Devices[J]) do
        Dec(J);
      if I <= J then begin
        Swap := Devices[J];
        Devices[J] := Devices[I];
        Devices[I] := Swap;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      Sort(L, J);
    if I < R then
      Sort(I, R);
  end;

  procedure WriteHelp;
    {Write a simple help screen}
  begin
    WriteLn;
    WriteLn('DEVICE produces a report showing the device drivers loaded into the system as');
    WriteLn('well as how much memory each uses, and what interrupt vectors are taken over.');
    WriteLn;
    WriteLn('DEVICE accepts the following command line syntax:');
    WriteLn;
    WriteLn('  DEVICE [Options]');
    WriteLn;
    WriteLn('Options may be preceded by either / or -. Valid options are as follows:');
    WriteLn('     /R     raw, unsorted report.');
    WriteLn('     /?     write help screen.');
    Halt(1);
  end;

  procedure GetOptions;
    {-Check for command line options}
  var
    Arg : String[127];
    I : Integer;
  begin
    RawMode := False;
    I := 1;
    while I <= ParamCount do begin
      Arg := ParamStr(I);
      if Length(Arg) = 2 then
        if (Arg[1] = '/') or (Arg[1] = '-') then
          case Upcase(Arg[2]) of
            'R' : RawMode := True;
            '?' : WriteHelp;
          end;
      Inc(I);
    end;
  end;

  function GetName(Header : DeviceHeader) : String;
  const
    Plural : array[Boolean] of String[1] = ('', 's');
  var
    Num : String[3];
  begin
    with Header do
      if (Attributes and $8000) <> 0 then
        GetName := DeviceName
      else begin
        Str(Ord(DeviceName[1]), Num);
        GetName := Num+' Block Unit'+Plural[Ord(DeviceName[1]) <> 1];
      end;
  end;

  procedure RawReport;
    {-Raw, unsorted device report}
  var
    D : Word;
  begin
    WriteLn;
    WriteLn(' Starting      Next             Strategy   Interrupt   Device');
    WriteLn(' Address     Hdr Addr   Attr   Entry Pnt   Entry Pnt   Name');
    WriteLn('---------   ---------   ----   ---------   ---------   --------');

    for D := 1 to DeviceCount do
      with Devices[D], Header do
        WriteLn(HexPtr(StartAddr), '   ',
                HexW(NextHeaderSegment), ':', HexW(NextHeaderOffset), '   ',
                HexW(Attributes), '   ',
                HexW(DeviceSegment), ':', HexW(StrategyEntPt), '   ',
                HexW(DeviceSegment), ':', HexW(InterruptEntPt), '   ',
                GetName(Header));
  end;

  function GetDosPtr : DosRecPtr;
    {-Return pointer to DOS internal variables table}
  var
    Regs : Registers;
  begin
    with Regs do begin
      AH := $52;
      MsDos(Regs);
      Dec(BX, 2);
      GetDosPtr := Ptr(ES, BX);
    end;
  end;

  function GetCommandPtr(DosPtr : DosRecPtr) : Pointer;
    {-Get the address of COMMAND.COM}
  type
    McbRec =
      record
        ID : Char;
        PSPSeg : Word;
        Len : Word;
      end;
  var
    McbPtr : ^McbRec;
  begin
    McbPtr := Ptr(DosPtr^.McbSeg, 0);
    McbPtr := Ptr(SO(McbPtr).S+McbPtr^.Len+1, 0);
    GetCommandPtr := Ptr(McbPtr^.PSPSeg, 0);
  end;

  procedure WriteDevice(StartAddr : Pointer;
                        Name : String;
                        Start, Stop : LongInt;
                        ShowVecs : Boolean);
    {-Write data for one device}
  var
    Size : LongInt;
    VecAddr : LongInt;
    Vec : Byte;
    Cnt : Byte;
    BPtr : ^Byte;
  begin
    Size := Stop-Start;
    ShowVecs := ShowVecs and (Size <> 0);

    Write(HexPtr(StartAddr), '   ');
    if Size <> 0 then
      Write(Size:6)
    else
      Write('     -');
    if ShowVecs then
      while Length(Name) < 14 do
        Name := Name+' ';
    Write('   ', Name);

    if ShowVecs then begin
      Cnt := 0;
      for Vec := 0 to $80 {!!} do begin
        VecAddr := PhysAddr(Pointer(MemL[0:4*Vec]));
        if (VecAddr >= Start) and (VecAddr < Stop) then
          {Points to this memory block}
          if Byte(Pointer(VecAddr)^) <> $CF then begin
            {Doesn't point to IRET}
            if Cnt >= 12 then begin
              WriteLn;
              Write('                                   ');
              Cnt := 0;
            end;
            inc(Cnt);
            Write(' ', HexB(Vec));
          end;
      end;
    end;
    WriteLn;
  end;

  procedure SortedReport;
    {-Sorted report better for user consumption}
  const
    NulDevice : array[1..8] of Char = 'NUL     ';
  var
    D : Word;
    DosCode : Pointer;
    CommandPtr : Pointer;
    DosPtr : DosRecPtr;
    DosBuffers : SftRecPtr;
    Start : LongInt;
    Stop : LongInt;
    FoundNul : Boolean;
  begin
    {Pointer to DOS variables}
    DosPtr := GetDosPtr;

    {Get the address of the lowest DOS code}
    DosCode := Ptr(SO(Devices[1].StartAddr).S, 0);

    {Get the address of the start of DOS's file tables}
    DosBuffers := DosPtr^.FirstSFT^.Next;

    {Get pointer to command.com}
    CommandPtr := GetCommandPtr(DosPtr);

    WriteLn;
    WriteLn(' Address     Bytes   Name           Hooked vectors');
    WriteLn('---------   ------   -------------- --------------');
    {        ssss:oooo   ssssss   nnnnnnnn       xx xx xx xx xx}

    {Display the devices}
    FoundNul := False;
    for D := 1 to DeviceCount-1 do begin
      if FoundNul then begin
        Start := PhysAddr(Devices[D].StartAddr);
        Stop := PhysAddr(Devices[D+1].StartAddr);
      end else if GetName(Devices[D].Header) = NulDevice then begin
        FoundNul := True;
        Start := PhysAddr(DosCode);
        Stop := PhysAddr(Devices[D+1].StartAddr);
      end else begin
        Start := 0;
        Stop := 0;
      end;
      {Protect against devices patched in after DOS}
      if Stop > PhysAddr(DosBuffers) then begin
        WriteLn('Detected device drivers patched in after CONFIG.SYS');
        Exit;
      end;
      with Devices[D] do
        WriteDevice(StartAddr, GetName(Header), Start, Stop, True);
    end;

    {Last device}
    with Devices[DeviceCount] do begin
      Start := PhysAddr(StartAddr);
      Stop := PhysAddr(DosBuffers);
      WriteDevice(StartAddr, GetName(Header), Start, Stop, True);
    end;

    {DOS buffers}
    Start := PhysAddr(DosBuffers);
    Stop := PhysAddr(CommandPtr);
    WriteDevice(DosBuffers, 'DOS buffers', Start, Stop, False);
  end;

begin
  WriteLn('DEVICE ', Version, ', by TurboPower Software');

  GetOptions;

  {Find the start of the device driver chain via the NUL device}
  FillChar(DeviceControlBlock, SizeOf(DeviceControlBlock), 0);
  with DeviceControlBlock do begin
    Filename := 'NUL     ';
    Extension := '   ';
    with Regs do begin
      AX := $0F00;
      DX := Ofs(DeviceControlBlock);
      DS := Seg(DeviceControlBlock);
      MsDos(Regs);
      if AL <> 0 then
        Abort('Error opening the NUL device');
    end;
    if Lo(DosVersion) > 2 then begin
      {DOS 3.0 or later}
      DeviceSegment := 0;
      DeviceOffset := FindNulDevice(DeviceSegment);
    end else begin
      {DOS 2.x}
      DeviceOffset := Word(Pointer(@Other[1])^);
      DeviceSegment := Word(Pointer(@Other[3])^);
    end;
    DevicePtr := Ptr(DeviceSegment, DeviceOffset);
  end;

  {Scan the chain, building an array}
  DeviceCount := 0;
  while SO(DevicePtr).O <> $FFFF do begin
    if DeviceCount < MaxDevices then begin
      Inc(DeviceCount);
      with Devices[DeviceCount] do begin
        StartAddr := Pointer(DevicePtr);
        Header := DevicePtr^;
      end;
    end;
    with DevicePtr^ do
      DevicePtr := Ptr(NextHeaderSegment, NextHeaderOffset);
  end;

  if RawMode then
    RawReport
  else begin
    {Sort the array in order of starting address}
    Sort(1, DeviceCount);
    SortedReport;
  end;
end.