home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB32.ZIP / STAYRES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-09-05  |  16.0 KB  |  355 lines

  1. {$C-}
  2. {-----------------------------------------------------------------------------}
  3. {                                                                             }
  4. {                                                                             }
  5. {         "  S o r r y ,  D a v e,   I   C a n ' t   D o   T h a t .  "       }
  6. {                                                                             }
  7. {                                                          Arthur C. Clark    }
  8. {                                                           " 2 0 0 1 "       }
  9. {-----------------------------------------------------------------------------}
  10. { Stayres Version 3.20
  11.  
  12. {  A  Turbo  "stay-resident" program clobbers the Dos register stack.  It
  13.   jumps over the Turbo run-time initialization code that would set up the
  14.   program registers  and environment.   Secondly,  a  stay-resident  program
  15.   could not ordinarily issue file I/O since that would clobber Dos interrupt
  16.   registers.  Therefore,  the following code proposes an inline solution,
  17.   providing a Turbo entry  stack  for  "stay-resident"  programs  and allowing
  18.   those programs to issue Dos I/O and other interrupts.
  19.  
  20.   This Turbo stay-resident demo has been put together to perform both Dos I/O
  21.   and Bios interrupts. It has been tested for re-entrancy and recursiveness
  22.   on an IBM PC with PCDos .
  23.  
  24.   Separate the include files, compile to a COM file and execute with the
  25.   Alt-F10 key. It will also free its memory and return to Dos with the
  26.   Ctrl-Home key at the "Press a key" prompt (Illustrated in the Stayxit
  27.   file). Maximum free dynamic memory should be between 300-400 paragraphs
  28.   since this demo uses a recursive stack. If you get $FF runtine errors or
  29.   "allocation error", "cannot load Command.Com", then raised the mAximum
  30.   free value. This program can only run as a COM file.
  31.  
  32.                                                  The Hunters Helper
  33.  
  34.                                                   Lane Ferris
  35.                                                   4268 26th St
  36.                                                   San Francisco,Ca. 94131
  37.                                                   [ 70357,2716 ]      }
  38. {-----------------------------------------------------------------------------}
  39. {     This code has been tested/used on an IBM PC using PC-DOS 2.10           }
  40. {-----------------------------------------------------------------------------}
  41.  
  42.  
  43. { Authors: Lane H. Ferris (Stay Resident/Exit Code)
  44.            Neil J. Rubenking (Directory code and ideas)
  45.            Other Public Gurus on whose shoulders we stand.
  46.  
  47. { PURPOSE:  This code will serve as a template to create other "Stay  Resident"
  48.             programs  in  Turbo  Pascal(tm).   This  code  intercepts  Int  16,
  49.             displacing original Interrupt  16  Vector  to  User  Interrupt  67.
  50.             During  execution  of  other  programs,  it  can  be invoked by the
  51.             special key combination  specified  by  "Our_Char"  (in  this  case
  52.             Alt-F10.)
  53.  
  54.   Modifications:
  55.            7. 7.85 - Replace Windows with a more simple form/less code.
  56.            7. 8.85 - Replace Window Array with Pointers/Heap form.
  57.            7.11.85 - Re-issue termination Keyboard Read / pass back to user
  58.                      Would like to back up Instruction Ptr by two bytes before
  59.                      the Int 16 ($CD16) but it might be a "long call" by
  60.                      some other Kbd interceptor (chirp chirp chrip)... and
  61.                      thats "trouble in River City".
  62.            7.19.85 - Clean up RmWin "incorrect" attribute bugs. If screen
  63.                      isnt cleared, we get border attribute, not text attrb.
  64.                    - Remove last window at Termination Time (Ctrl-Home).
  65.            8.26.85 - Version 3.10 Changes
  66.                      1) Save 40 words in StaySave/Rstr to avoid clobbersing
  67.                         Dos Stack when entering Dos with Turbo Write(ln) caused
  68.                         by Int 21 Function 5  (Writln(Lst,..)) which re-issues
  69.                         Int 16.
  70.                      2) Change Int 68 to Int 67 to Avoid collisions with
  71.                         Dos 3.1 on an AT.
  72.                      3) Correct "Press a Key..." to accept any "Key..."
  73.                         (not just Cr).
  74.                      4) Check Int16 function. Jmp directly to Int16 if not
  75.                         a character request. Avoids 40 word Save/Restore
  76.                         overhead.
  77.            9.04.85 - Version 3.20 changes
  78.                      1) When returning to user program, pass back a fake
  79.                         "Ctrl-key" scan code to allow immediate re-execution
  80.                         of the TSR (Terminate Stay Resident) program. Also
  81.                         solves SideKick incessant bird caws.
  82. }
  83. Program Stay_Resident;
  84.  
  85. { * * * * * * * CONSTANTS * * * * * * * * * * * * * * * * * * * * * * }
  86.   const
  87.     Our_Char        =  113; {this is the scan code for AltF10}
  88.     Ctrl_Home       = #119; {Control Home Scan Code          }
  89.     Quit_Key        = #119;
  90.     Ctrl_End        = #117; {Control End Scan Code           }
  91.     User_Int        = $67; {place to put new interrupt}
  92.     Kybrd_Int       = $16; {BIOS keyboard interrupt}
  93.  
  94. {  - - - - - - T Y P E    D E C L A R A T I O N S - - - - - - - - - - - -  }
  95.   Type
  96.     Regtype     = record Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags:integer  end;
  97.     HalfRegtype = record Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh:byte              end;
  98.     filename_type = string[64];
  99.  
  100. { - - - - - - - T Y P E D   C O N S T A N T S - - - - - - - - - - - - - - -}
  101.   Const
  102.     {regs is defined as a typed constant in order to get it in the code segment}
  103.  
  104.       Regs   : regtype = (Ax:0;Bx:0;Cx:0;Dx:0;Bp:0;Si:0;Di:0;Ds:0;Es:0;Flags:0);
  105.  
  106.       OurDseg: integer = 0;            {Our Data Segment Value             }
  107.       OurSseg: integer = 0;            {Our Stack Segment Value            }
  108.       DosSseg: integer = 0;            {Dos Stack Segment Value            }
  109.       Inuse  : Boolean = false;        {Recursion flag                     }
  110.      { The following two constants *MUST* remain in the Ip:CS order        }
  111.      { because StaySave uses them as a JMP target                          }
  112.       User_IntIP : integer = 0;        {Pointer to Original IP Int value   }
  113.       User_IntCs : integer = 0;        {Pointer to Original Cs Int value   }
  114.  
  115.  { - - - - - - - V A R I A B L E S - - - - - - - - - - - - - - - - - - - - - -}
  116.     Var
  117.       SaveRegs                      : regtype;
  118.       HalfRegs                      : halfregtype absolute regs;
  119.       Terminate_flag                : boolean ;
  120.       Keychr                        : char ;
  121.       Old_Xpos,Old_Ypos             : integer ;
  122.       x,y                           : integer ;
  123.  
  124.  
  125. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  126. {$I Nwindo.300}                    { W i n d o w  M a k e r                   }
  127. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  128. {  Check Terminate Keys
  129. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  130. {$I StayXit.320}                   {Check for Exit to Dos                     }
  131. {-----------------------------------------------------------------------------}
  132. {            G  E  T  F  I  L  E                                              }
  133. {-----------------------------------------------------------------------------}
  134. Procedure Get_file;
  135. {$I staysubs.300}
  136. var
  137.   Trash        : char;
  138.   attribyte,
  139.   OldAttribute : byte;
  140.   Xcursor      : integer ;
  141.   Ycursor      : integer ;
  142. {----------------------------------------------------------------------------}
  143. begin
  144.  
  145.       filename := '*.*' ;
  146.       attribyte := 255 ;
  147.       OldAttribute := attribyte;
  148.  
  149.               Xcursor := 2 ;
  150.               Ycursor := 1 ;
  151.               GotoXy(Xcursor,Ycursor) ;
  152.  
  153.           Find_First(attribyte,filename,Retcode);
  154.               If Retcode = 0 then
  155.                  begin
  156.                  write(Filename);
  157.                  Ycursor := Ycursor +1 ;
  158.                  end;
  159.           {Now we repeat Find_Next until an error occurs }
  160.  
  161.               repeat
  162.                 Find_Next(attribyte,filename,Retcode);
  163.                 if Retcode = 0 then
  164.                  begin
  165.                         GotoXY(Xcursor,Ycursor);
  166.                         Write(filename) ;
  167.                         Ycursor := Ycursor + 1 ;
  168.  
  169.                         if WhereY >= 14 then
  170.                         begin
  171.                         Xcursor := Xcursor + 16 ;
  172.                         Ycursor := 1 ;
  173.                         end;
  174.  
  175.                         if (Xcursor >= 50) and (Ycursor = 13 ) then
  176.                         begin
  177.                         Ycursor := Ycursor + 1;
  178.                         GotoXY(Xcursor,Ycursor);
  179.  
  180.                         Get_Abs_Cursor(x,y);    { Box up More msg..}
  181.                         MkWin(x,y,x+9,y+3,Cyan); Gotoxy(1,1);
  182.                         Write ('More...');
  183.  
  184.                         While (Not Keypressed) do;
  185.                         Read(Kbd,trash) ;
  186.                         RmWin;                  { Remove "More" window }
  187.  
  188.                         clrscr ;
  189.                         Xcursor := 2 ;
  190.                         Ycursor := 1 ;
  191.                         end;
  192.                  end;
  193.                until Retcode <> 0;
  194.                                        { Make a little Window and hold for }
  195.                                        { user to give us a goose..or whatever}
  196.                GotoXY(Xcursor,Ycursor);
  197.                Get_Abs_Cursor(x,y);        { Get Absolute Cursor Position  }
  198.                MkWin(x,y,x+12,y+3,Cyan);   { Put Window at Cursor   }
  199.                GotoXY(1,1);
  200.                Write('Press a key . . .');
  201.  
  202.                While (Not Keypressed) do;  { Pause until Key pressed }
  203.                While Keypressed do         { Get Ctrl-Home maybe     }
  204.                Read(Kbd,KeyChr);           { Read the users Key      }
  205.                RmWin ;                     { Remove the Window       }
  206.                If KeyChr = Quit_Key then   { If Terminate Key then   }
  207.                            Stay_Xit ;      { remove ourself from  Memory }
  208. end;
  209.  
  210. {-----------------------------------------------------------------------------}
  211. {        D   E  M  O                                                          }
  212. {-----------------------------------------------------------------------------}
  213. Procedure Demo ;                   { Give Demonstration of Code               }
  214.  
  215. begin
  216.      KeyChr := #0;
  217.      MkWin(5,5,75,20,Cyan);
  218.      TextColor(White);
  219.      Clrscr;
  220.      Get_file;
  221.  
  222.      RmWin;
  223.  
  224. end; { Demo }
  225.  
  226.  
  227. {----------------------------------------------------------------------------}
  228. {              P R O C E S S   I N T E R R U P T                             }
  229. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  230. Procedure Process_Intr;
  231.  
  232. {  PURPOSE:  This  procedure  replaces  the  standard  keyboard  interrupt.  If
  233.             anything but <Alt>-F10 is pressed,  the key is  passed  on  to  the
  234.             standard  keyboard  interrupt.  B*U*T  when  <Alt>- F10 is pressed,
  235.             this program takes over.  The variable InUse  is  set  to  TRUE  to
  236.             ensure that this code doesn't try to run "on top of itself " AND to
  237.             indicate  to the Inline code to save/restore the original interrupt
  238.             regs.
  239. }
  240. Begin
  241.           { K e y b o a r d    Interrupt   o c c u r s   here }
  242. {----------------------------------------------------------------------}
  243. {$I Staysave.320}
  244. {----------------------------------------------------------------------}
  245. { Check the Int 16 request function in Ah reg:
  246.                    0 = read character from Keyboard
  247.                    1 = check character available
  248.                    2 = check shift key values
  249. }
  250.  
  251.           { HalfRegs.Ah = 0  This is a Character Request because StaySave }
  252.           { doesnt allow an enter here unless it is!                      }
  253.  
  254.   Intr (User_Int, Regs);             { Use the DOS replaced interrupt}
  255.                                      { Get Key from Keyboard         }
  256.   If (Halfregs.Ah = Our_Char)        { Separate the tests so code    }
  257.                                      { performs efficiently.         }
  258.      then if  (not InUse) then       { Must be OUR key and not busy  }
  259.  
  260.         Begin { Demo }
  261.         InUse := true;                  { "dont clobber saved stack"}
  262. {            .
  263.              .
  264.              .  Your
  265.              .      Program
  266.              .             Goes
  267.              .                 Here
  268.              .
  269. }                                    { Get current Cursor Position    }
  270.         Old_Xpos := WhereX; Old_Ypos := WhereY;
  271.         Demo ;
  272. {       Writeln(Lst,'That''s all Folks');{ Test Printer Output if you like }
  273.         GotoXY(Old_Xpos,Old_Ypos);       { Put Cursor Back                 }
  274.         Regs.Ax := $1D00;                { Give Dummy Ctrl Scan Code to    }
  275.                                          {           interrupted program   }
  276.         InUse := false;                  { ok to restore interrupted stack }
  277.         End;  { Demo }
  278.  
  279. {$I Stayrstr.310}                      { Return to Caller }
  280. End ;{Process_Intr}
  281. {-----------------------------------------------------------------------}
  282.  
  283. {The main program installs the new interrupt routine and makes it permanently
  284.  resident as the keyboard interrupt.  The old keyboard interrupt is addressed
  285.  through #67H, so it can still be used.
  286.  
  287. The following dos calls are used:
  288.  
  289.  Function 25 - Install interrupt address
  290.                input al = int number,
  291.                ds:dx = address to install
  292.  Function 35 - get interrupt address
  293.                input al = int number
  294.                output es:bx = address in interrupt
  295.  Function 31 - terminate and stay resident
  296.                input dx = size of resident program obtained from the memory
  297.                allocation block at [Cs:0 - $10 + 3]
  298.  Function 49 - Free Allocated Memory
  299.                input Es = Block Segment to free
  300.  Interrupt 20 - Return to invoking process
  301. }
  302.  
  303. {-----------M A I N    B L O C K---------------------------------------------}
  304. Begin                                  {**main**}
  305.  
  306.   InUse  := false;
  307.   OurDseg:= Dseg;           { Save the Data Segment Address for Interrupts }
  308.   OurSseg:= Sseg;           { Save our Stack Segment for Interrupts        }
  309.  
  310.  
  311.   Terminate_Flag := false ;
  312.  
  313.   {now install the interrupt routine}
  314.  
  315.   SaveRegs.Ax := $35 shl 8 + User_Int;
  316.   Intr($21,SaveRegs);                 {Check to make sure int not already used}
  317.  
  318.   if SaveRegs.Es <> $00 then
  319.     WriteLn ('Interrupt in use -- can''t install Resident Turbo Code')
  320.   else
  321.     begin
  322.  
  323.       { Initialize Your Progam Here since you wont get control again
  324.         until "Our_Char" is entered from the Keyboard.               }
  325.  
  326.       SaveRegs.Ax := $35 shl 8 + Kybrd_Int;
  327.       Intr($21,SaveRegs);        {get the address of keyboard interrupt }
  328.  
  329.       SaveRegs.Ax := $25 shl 8 + User_Int;
  330.       SaveRegs.Ds := SaveRegs.Es;
  331.       SaveRegs.Dx := SaveRegs.Bx;
  332.       Intr($21,SaveRegs);       { set the user-interrupt address to point
  333.                                 { to the keyboard interrupt address }
  334.  
  335.       SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
  336.       SaveRegs.Ds := Cseg;
  337.       SaveRegs.Dx := Ofs(Process_Intr);
  338.       Intr ($21,SaveRegs);        { set the keyboard interrupt to point to
  339.                                   "Process-Intr" above}
  340.  
  341.       User_IntIp := MemW[0:User_Int * 4 ];  { Location of User Interrupt Ip }
  342.       User_IntCs := MemW[0:User_Int * 4 +2];{ Location of User Interrupt Cs }
  343.  
  344.       Writeln('  Turbo Stay-Resident Demo: Press Alt-F10');
  345.  
  346.       {now terminate and stay resident}
  347.                                               { Pass return code of zero    }
  348.       SaveRegs.Ax := $31 shl 8 + 0 ;          { Terminate and Stay Resident }
  349.       SaveRegs.Dx := MemW [Cseg-1:0003] ;     { Prog_Size from Allocation Blk}
  350.       Intr ($21,SaveRegs);
  351.  
  352.     end;
  353.        { END OF RESIDENCY CODE }
  354. end.
  355.