Frostbyte's 1980s DOS Shareware Collection/floppyshareware.zip/floppyshareware/GLEN/TSRSRC32.ZIP/DEVICE.PAS

Pascal/Delphi Source File | 1991-11-22 | 11KB | 386 lines

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

 version 3.0 9/2/91
   reorganize source code for consistency with other utilities
 version 3.1 11/4/91
   no change
 version 3.2 11/22/91
   no change
}

{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 2048,0,655360}

program Device_Chain;

uses
  Dos,
  MemU;

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

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;

  DisplayRec =
    record
      StartAddr : Pointer;
      Header : DeviceHeader;
    end;
  DisplayArray = array[1..MaxDevices] of DisplayRec;

var
  DeviceControlBlock : FileControlBlock; {File Control Block for NUL Device}
  DevicePtr : ^DeviceHeader;      {Pointer to the next device header}
  DeviceSegment : Word;           {Current device segment}
  DeviceOffset : Word;            {Current device offset}
  DeviceCount : Word;             {Number of devices}
  Devices : DisplayArray;         {Sortable list of devices}
  RawMode : Boolean;
  NulStatus : Byte;

  procedure Abort(Msg : String);
  begin
    WriteLn(Msg);
    Halt(1);
  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(OS(X).S) shl 4)+OS(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;
    {-Get a device name}
  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 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(OS(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 := Ptr(OS(DosList).S, OS(DosList).O-2);

    {Get the address of the lowest DOS code}
    DosCode := Ptr(OS(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, ', Copyright 1991 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 := '   ';
    asm
      mov ax,$0F00
      mov dx,offset devicecontrolblock
      int $21
      mov NulStatus,al
    end;
    if NulStatus <> 0 then
      Abort('Error opening the NUL device');
    if Hi(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 OS(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.