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.


  3 Responses to “Category : Pascal Source Code
Archive   : MAPFILES.ZIP
Filename : UNDOCDOS.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. 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/