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

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

{****************************************************************************}
{* MAPFILES - Utility to show open files by all programs in memory *}
{* by Richard S. Sadowsky *}
{* Version 1.0 2/9/91 *}
{* *}
{* This program requires DOS 3.0 or greater. *}
{* This program writes to standard output, so it may be redirected. *}
{****************************************************************************}
{$V-,R-,S-}
program MapFiles;
uses Dos, UnDocDos;

function UpperCaseSt(S : String) : String;
{-Convert S to all uppercase characters and return as function result}
var
I : Byte;
begin
for I := 1 to Length(S) do
S[I] := UpCase(S[I]);
UpperCaseSt := S;
end;

procedure DisplayFiles(M : McbPtr);
{-Display the program name, and its open files}
var
I : Byte;
PSP : PspPtr;
ProgName : String;
Name : String15;
Success : Boolean;
NumFiles : Byte;
begin
{check to see if this MCB is a program's PSP, and if so, make sure it isn't
the PSP of this program}
if IsPsp(M) and (M^.mcbOwnerPSP <> PrefixSeg) then begin
{create a pointer to the program segment prefix}
PSP := Ptr(M^.mcbOwnerPSP, 0);
{get program name from environment}
ProgName := UpperCaseSt(ProgramName(M^.mcbOwnerPSP));
if ProgName = '' then
ProgName := 'n/a';
WriteLn('Program name: ', ProgName);
NumFiles := 0;
with PSP^ do
for I := 0 to NumHandles-1 do begin
Name := NameFromHandle(SegOfs(PSP).S, I, Success);
if Success then begin
WriteLn(' handle ', I:2,' ',
Copy(Name, 1, 8), ' ',
Copy(Name, 9, 3));
Inc(NumFiles);
end;
end;
if NumFiles = 0 then
WriteLn(' no open files');
end;
end;

{$F+}
procedure McbWalker(M : McbPtr);
{-Gets called for each MCB in the MCB chain. Calls DisplayFiles.}
begin
if M = Nil then begin
WriteLn('invalid MCB type');
Exit;
end;
DisplayFiles(M);
end;

begin {main}
WriteLn('MapFiles 1.0 by Richard Sadowsky');
if Lo(DosVersion) < 3 then begin
WriteLn;
WriteLn('This program requires DOS 3.0 or greater');
Halt(1);
end;
WalkMcbChain(GetFirstMcb, McbWalker);
end. {main}