jrwsnsr@nmt.edu (Jonathan R. Watts) (07/09/90)
I've written a 4DOS unit for TP (5.5, but should work with 4.0 on up),
which I'm willing to share with the world, but I'm having a problem with
the StackKeys function (which is SUPPOSED to push keys onto the key stack,
as documented on p. 150 of the 4DOS 3.0 manual); it often screws up the
first keypress passed, and it almost always drops the last keypress passed.
Its exact behavior is unpredictable. I've included a complete description
of the problem in the source code for the unit (after the procedure heading
for "StackKeys" in the implementation). I'll also post the little testing
program I wrote to test the unit out. Everything other than StackKeys works
exactly as it should. The source code is documented well enough that you
should have no trouble understanding what it's SUPPOSED to do!
BTW, the integrated environment apparently clears the key stack after the
program exits, so my testing program doesn't work within it! (Actually, all
I need to to is add another Readln after stacking the keys...I only just
thought of that!)
Feel free to post or e-mail replies...I'll get them either way.
------- unit JRW4DOS begin ----------
unit JRW4DOS;
{ This unit contains routines that will only work if 4DOS is present
(They are all smart enough to check before doing anything.)
Written by Jonathan Watts.
Internet address: jrwsnsr@jupiter.nmt.edu
US Mail (college): Box #2577 C/S
Socorro, NM 87801
}
interface
{--------------}
uses
Dos;
{--------------}
function Resident4DOS : boolean;
{ Returns true if 4DOS is resident. }
function Parent4DOS : boolean;
{ Returns true if 4DOS is the parent of the current program (thus avoiding
bogus CMDLINE values if 4DOS is not the parent...I use this in my
command line interpreting unit to allow me to transparently use the full
255-character command line passed by 4DOS if available. }
procedure StackKeys(Strng : string);
{ Uses the KEYSTACK device driver to add keypresses to the key stack. }
{==================================================================}
implementation
{--------------}
const
KeyStackDriverName = '4DOSSTAK'; { The name of the KEYSTACK driver }
ResidentKeyStack : boolean = False;
{--------------}
var
Res4DOS,
Par4DOS : boolean;
Ver4DOS : word;
KeyStack : text;
ExitSave4DOS : pointer;
{--------------}
{$F+}
procedure ExitProc4DOS;
begin
ExitProc := ExitSave4DOS;
Close(KeyStack) { Closes the KEYSTACK "file" }
end; { ExitProc4DOS }
{$F-}
{--------------}
procedure CheckFor4DOS;
{ Sets the internal variables used by Resident4DOS, Parent4DOS,
and Version4DOS. }
type
WordPtr = ^word;
var
Regs : Registers;
begin
with Regs do begin
AX := $D44D;
BX := 0;
Intr($2F, Regs);
if (AX = $44DD) then begin { 4DOS returns $44DD in AX }
if (CX = WordPtr(Ptr(PrefixSeg, $16))^) then
{ 4DOS returns its PSP in CX; this ^^^ compares CX with the PSP of
the current program's parent (offset $16 in the current PSP). }
Par4DOS := True
else Par4DOS := False;
Ver4DOS := BX; { 4DOS returns the version number in BX }
Res4DOS := True
end
else Res4DOS := False
end
end; { CheckFor4DOS }
{--------------}
function Resident4DOS : boolean;
begin
Resident4DOS := Res4DOS
end; { Resident4DOS }
{--------------}
function Parent4DOS : boolean;
begin
Parent4DOS := Par4DOS
end; { Parent4DOS }
{--------------}
procedure Version4DOS(var Major, Minor : byte);
{ Returns the major and minor version numbers of the resident copy of 4DOS. }
begin
if Resident4DOS then begin
Major := Lo(Ver4DOS);
Minor := Hi(Ver4DOS)
end
else begin
Major := 0;
Minor := 0
end
end; { Version4DOS }
{--------------}
procedure StackKeys(Strng : string);
{ Adds the specified keys to the keystack, just as if you had typed
"KEYSTACK <Strng>", where <Strng> is the contents of Strng, on the
command line (see the 4DOS manual for an explanation of how the
device driver interprets the string). }
{ This procedure does not currently work correctly! Symptoms:
It often screws up the first character, usually (but not always...it's not
predictable) shifting it up by 20 decimal (i.e., #13 [Carriage Return]
becomes #33 [Exclamation Point]!).
If often does not push the last character.
I would be very grateful if anyone could explain what the &#@% is
happening! (See p.150 of the 4DOS 3.0 manual [Appendix D] for
the info on using the KEYSTACK within a program.) }
var
Regs : Registers;
begin
if ResidentKeyStack then with Regs do begin
AX := $4403; { IOCTL: Send control data to device }
BX := TextRec(KeyStack).Handle; { BX = The handle of the keystack }
CX := Length(Strng); { CX = length of the string to stack }
DS := Seg(Strng[1]); { DS:DX = address of string...We DON'T }
DX := Ofs(Strng[1]); { want to include the length byte! }
MsDos(Regs)
end
end; { StackKeys }
{--------------}
begin { JRW4DOS }
CheckFor4DOS;
if Resident4DOS then begin
Assign(KeyStack, KeyStackDriverName); { Open KEYSTACK device driver, }
{$I-} Rewrite(KeyStack); {$I+} { so keys can be pushed. }
ResidentKeyStack := (IOResult = 0);
if ResidentKeyStack then begin
ExitSave4DOS := ExitProc; { Set up the exit procedure so }
ExitProc := @ExitProc4DOS { that the KEYSTACK device is }
{ automatically closed. }
end
end
end. { JRW4DOS }
---------- unit JRW4DOS end ---------
---------- program TEST4DOS begin --------
program Test4DOS;
uses
Crt,
JRW4DOS;
var
StackString : string;
begin
ClrScr;
Write('4DOS is ');
if not Resident4DOS then
Write('not ');
Writeln('resident.');
if Resident4DOS then begin
Write('4DOS is ');
if not Parent4DOS then
Write('not ');
Writeln('the parent process of this program.');
Writeln;
Write('String to stack: ');
Readln(StackString);
StackKeys(StackString)
end;
Writeln;
Writeln('Exiting in 2 seconds...');
Delay(2000)
end.
------- program TEST4DOS end --------
- Jonathan Watts
jrwsnsr@jupiter.nmt.edu (Internet address)