Category : Pascal Source Code
Archive   : MAPFILES.ZIP
Filename : UNDOCDOS.PAS

 
Output of file : UNDOCDOS.PAS contained in archive : MAPFILES.ZIP

{
UNDOCDOS unit version 1.0 2/9/91

Routines based on information contained in:
Undocumented Dos
Addison Wesley Publishing Company
ISBN 0-201-57064-5

Implemented in Turbo Pascal by:
Richard S. Sadowsky
Compuserve ID 76074,1670
}
{$V-,R-,S-}
unit UnDocDos;
interface
uses
Dos;
type
{general purpose types}
String15 = String[15];
WordArray = Array[0..$FFF0 div SizeOf(Word)] of Word;
WordArrayPtr = ^WordArray;
CharArray = Array[0..$FFF0] of Char;
CharArrayPtr = ^CharArray;

{a record the of the structure of a Memory Control Block}
McbPtr = ^Mcb;
Mcb =
record
mcbType : Char;
mcbOwnerPSP : Word;
mcbSize : Word; {in paragraphs}
Unused : Array[1..3] of Char;
Dos4 : Array[1..8] of Char;
end;
McbWalkProc = procedure (McbP : McbPtr);

{native format of a far pointer}
SegOfs =
record
O, S : Word;
end;

{types defining a DOS handle table}
HandleTable = Array[1..255] of Byte;
HandleTablePtr = ^HandleTable;

{a dummy type to leave space in PSPType for FCBs}
FcbType =
record
Ofs0 : Byte;
Ofs1 : Array[1..11] of Char;
Ofs2 : Array[1..4] of Byte;
end;

{a record to describe important fields in a Program Segment Prefix}
PSPPtr = ^PSPType;
PSPType =
record
Fini : Word;
NextUnused : Word;
Filler : Byte;
CpmCall : Array[1..5] of Byte;
ISV22 : Pointer;
ISV23 : Pointer;
ISV24 : Pointer;
PSPofParent : Word;
Handles : Array[1..20] of Byte;
EnvSeg : Word;
SaveStack : Pointer;
NumHandles : Word;
HandleTable : HandleTablePtr;
SharesPrev : Pointer;
Reserved1 : Array[1..20] of Byte;
UnixDispatch : Array[1..3] of Byte;
Reserved2 : Array[1..9] of Byte;
FCB1 : FcbType;
FCB2 : FcbType;
Reserved3 : Array[1..4] of Byte;
TailCount : Byte;
Tail : Array[1..127] of Char;
end;

function NameFromHandle(PSP : Word;
Handle : Word;
var Successful : Boolean) : String15;
{-Given a PSP and a file handle, return the file name}

function GetFirstMCB : McbPtr;
{-Get the first MCB in the MCB chain}

procedure WalkMcbChain(McbP : McbPtr; WalkFunc : McbWalkProc);
{-Call WalkFunc for each MCB above McbP}

function IsPsp(McbP : McbPtr) : Boolean;
{-Returns True if McbP belongs to a program segment prefix}

function ProgramName(PSP : Word) : String;
{-Return the name of the program specified by PSP}

implementation
var
ListOfs : Word;
ListSeg : Word;
ListOfLists : Pointer absolute ListOfs;

function NameFromHandle(PSP : Word;
Handle : Word;
var Successful : Boolean) : String15;
var
Name : String15;
Htbl, StPtr : CharArrayPtr;
Pt : WordArrayPtr;
NameOfs : Word;
SftN, SftSize : Word;
begin
Successful := False;
NameFromHandle := '';
FillChar(Name, 0, SizeOf(Name));
Htbl := Pointer(Ptr(PSP, $34)^);
Pt := Pointer(Ptr(ListSeg, ListOfs + 4)^);
case Lo(DosVersion) of
2 :
begin
SftSize := $28;
NameOfs := 4;
end;
3 :
begin
SftSize := $35;
NameOfs := $20;
end;
4, 5 :
begin
SftSize := $3B;
NameOfs := $20;
end;
else
Exit;
end;
SftN := Word(Htbl^[Handle]);
if ShortInt(SftN) >= 0 then begin
while Word(Pt) <> $FFFF do begin
if Pt^[2] > SftN then begin
StPtr := CharArrayPtr(@Pt^[3]);
while (SftN > 0) do begin
Inc(Word(StPtr), SftSize);
Dec(SftN);
end;
Move(StPtr^[NameOfs], Name[1], 11);
Name[0] := #11;
NameFromHandle := Name;
Successful := True;
Exit;
end;
Dec(SftN, Pt^[2]);
Pt := Ptr(Pt^[1], Pt^[0]);
end;
end;
end;

function GetFirstMCB : McbPtr;
type
WordPtr = ^Word;
begin
GetFirstMcb := Ptr(WordPtr(Ptr(ListSeg, ListOfs-2))^, 0);
end;

procedure WalkMcbChain(McbP : McbPtr; WalkFunc : McbWalkProc);
begin
repeat
case McbP^.mcbType of
'Z' :
begin
WalkFunc(McbP);
Exit;
end;
'M' :
begin
WalkFunc(McbP);
with McbP^ do
McbP := Ptr(SegOfs(McbP).S + mcbSize + 1, 0);
end;
else begin
WalkFunc(Nil);
Exit;
end;
end;
until False;
end;

function IsPsp(McbP : McbPtr) : Boolean;
begin
IsPsp := (Succ(SegOfs(McbP).S) = McbP^.mcbOwnerPSP) and
(McbP^.mcbOwnerPSP <> 8);
end;

function GoodName(var S : String) : Boolean;
{-Borrowed from Kim Kokkonen's MAPMEM}
var
I : Byte;
begin
GoodName := True;
for I := 1 to Length(S) do
if (S[I] <> #0) and ((S[I] < ' ') or (S[I] > '}')) then begin
GoodName := False;
Exit;
end;
end;

function ProgramName(PSP : Word) : String;
var
EnvPtr : ^Char;
S : String;

begin
ProgramName := '';
if Lo(DosVersion) < 3 then
Exit;
EnvPtr := Ptr(PSPPtr(Ptr(PSP, 0))^.EnvSeg, 0);
while EnvPtr^ <> #0 do begin
while EnvPtr^ <> #0 do
Inc(EnvPtr);
Inc(EnvPtr);
end;
Inc(EnvPtr, 3);
S[0] := #128;
Move(EnvPtr^, S[1], 128);
S[0] := Char(Pos(#0, S)-1);
if not GoodName(S) then
S := '';
ProgramName := S;
end;

function GetListOfLists : Pointer;
var
Regs : Registers;
begin
with Regs do begin
AH := $52;
MsDos(Regs);
GetListOfLists := Ptr(ES, BX);
end;
end;

begin
ListOfLists := GetListOfLists;
end.