Category : Pascal Source Code
Archive   : TSRSRC33.ZIP
Filename : DEVICE.PAS
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
version 3.3 1/8/93
increase stack space
new features for parsing and getting command line options
}
{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 4096,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];
procedure GetArgs(S : String);
var
SPos : Word;
begin
SPos := 1;
repeat
Arg := NextArg(S, SPos);
if Arg = '' then
Exit;
if Length(Arg) = 2 then
if (Arg[1] = '/') or (Arg[1] = '-') then
case Upcase(Arg[2]) of
'R' : RawMode := True;
'?' : WriteHelp;
end;
until False;
end;
begin
RawMode := False;
{Get arguments from the command line and the environment}
GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
GetArgs(GetEnv('DEVICE'));
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.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/