Path: utzoo!attcan!uunet!midway!ncar!boulder!sunybcs!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!unmvax!nmt.edu!jrwsnsr
From: jrwsnsr@nmt.edu (Jonathan R. Watts)
Newsgroups: comp.lang.pascal
Subject: Using 4DOS from TP programs
Message-ID: <1990Jul9.085437.26398@nmt.edu>
Date: 9 Jul 90 08:54:37 GMT
Organization: New Mexico Institute of Mining and Technology
Lines: 228

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)