home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / UT.ZIP / UT.PAS
Encoding:
Pascal/Delphi Source File  |  1986-06-27  |  14.0 KB  |  311 lines
  1. {$C-}
  2. {-----------------------------------------------------------------------------}
  3. {     This code has been tested/used on an IBM PC using PC-DOS 2.10           }
  4. {-----------------------------------------------------------------------------}
  5.  
  6. { Compiling:  This program must be compiled with Turbo pascal to a COM file.
  7.            Select the options, select C, select I and enter 300,
  8.            select A and enter 400.  Then select Q and then C. }
  9.  
  10. { Authors: Lane H. Ferris (Stay Resident/Exit Code)
  11.            Neil J. Rubenking (Directory code and ideas)
  12.            Other Public Gurus on whose shoulders we stand.
  13.  
  14. { PURPOSE:  This code will serve as a template to create other "Stay  Resident"
  15.             programs  in  Turbo  Pascal(tm).   This  code  intercepts  Int  16,
  16.             displacing original Interrupt  16  Vector  to  User  Interrupt  67.
  17.             During  execution  of  other  programs,  it  can  be invoked by the
  18.             special key combination  specified  by  "Our_Char"  (in  this  case
  19.             Alt-F10.)
  20.  
  21. }
  22. Program Stay_Resident;
  23.  
  24. { * * * * * * * CONSTANTS * * * * * * * * * * * * * * * * * * * * * * }
  25.   const
  26.     Our_Char        =  113; {this is the scan code for AltF10}
  27.     Ctrl_Home       = #119; {Control Home Scan Code          }
  28.     Quit_Key        = #119;
  29.     Ctrl_End        = #117; {Control End Scan Code           }
  30.     User_Int        = $67; {place to put new interrupt}
  31.     Kybrd_Int       = $16; {BIOS keyboard interrupt}
  32.  
  33. {  - - - - - - T Y P E    D E C L A R A T I O N S - - - - - - - - - - - -  }
  34.   Type
  35.     Regtype     = record Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags:integer  end;
  36.     HalfRegtype = record Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh:byte              end;
  37.     filename_type = string[64];
  38.  
  39. { - - - - - - - T Y P E D   C O N S T A N T S - - - - - - - - - - - - - - -}
  40.   Const
  41.     {regs is defined as a typed constant in order to get it in the code segment}
  42.  
  43.       Regs   : regtype = (Ax:0;Bx:0;Cx:0;Dx:0;Bp:0;Si:0;Di:0;Ds:0;Es:0;Flags:0);
  44.  
  45.       OurDseg: integer = 0;            {Our Data Segment Value             }
  46.       OurSseg: integer = 0;            {Our Stack Segment Value            }
  47.       DosSseg: integer = 0;            {Dos Stack Segment Value            }
  48.       Inuse  : Boolean = false;        {Recursion flag                     }
  49.      { The following two constants *MUST* remain in the Ip:CS order        }
  50.      { because StaySave uses them as a JMP target                          }
  51.       User_IntIP : integer = 0;        {Pointer to Original IP Int value   }
  52.       User_IntCs : integer = 0;        {Pointer to Original Cs Int value   }
  53.  
  54.  { - - - - - - - V A R I A B L E S - - - - - - - - - - - - - - - - - - - - - -}
  55.     Var
  56.       SaveRegs                      : regtype;
  57.       HalfRegs                      : halfregtype absolute regs;
  58.       Terminate_flag                : boolean ;
  59.       Keychr                        : char ;
  60.       Old_Xpos,Old_Ypos             : integer ;
  61.       x,y                           : integer ;
  62.  
  63.  
  64. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  65. {$I Nwindo.300}                    { W i n d o w  M a k e r                   }
  66. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  67. {  Check Terminate Keys
  68. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  69. {$I StayXit.320}                   {Check for Exit to Dos                     }
  70.  
  71. {---------------------------------------------------------------------------- }
  72. {                        DIRECTORY  PROCEDURE                                 }
  73. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  74. Procedure Direct;
  75.  
  76. Var
  77.     Chd      : Char;                   { command character      }
  78.     DirName, OldName  : String[40];    { directory name         }
  79.     Xcursor  : integer ;               { cursor postions        }
  80.     Ycursor  : integer ;
  81.     OK, DONE : Boolean;                { logical expressions    }
  82.  
  83. Begin
  84.    KeyChr := #0;
  85.    MkWin(15,5,65,20,Cyan);             { make a large window    }
  86.    TextColor(White);                   { set color to white     }
  87.  
  88.    Repeat                              { start main loop        }
  89.      DONE:=FALSE;                      { initiate done          }
  90.      ClrScr;                           { clear window           }
  91.  
  92.      { menu options                                             }
  93.      GotoXY(20,1); Write('Options');
  94.      GotoXY(9,2); Write('<M> MAKE A New Directory On B:');
  95.      GotoXY(9,3); Write('<C> CHANGE Directory On B:');
  96.      GotoXY(9,4); Write('<R> RETURN To Root Directory On B:');
  97.      GotoXY(9,5); Write('<S> SHOW Current Directory of B:');
  98.      GotoXY(9,6); Write('<E> EXIT this Utility');
  99.  
  100.      GotoXY(12,8); ClrEol;
  101.      Write('Enter Option Letter: ');
  102.      ReadLn(Chd);                      { get option number      }
  103.  
  104.      If (Chd='M') or (Chd='m') then Begin { make a new directory   }
  105.         GetDir(0,OldName);             { get current dir in use }
  106.         DirName:='';                   { initiate name          }
  107.         GotoXY(2,10); Write('New Directory or <CR> to Quit ? ');
  108.         ReadLn(DirName);               { get new name           }
  109.         If DirName<>'' then Begin      { do if not nul          }
  110.            DirName:='B:\'+ DirName;    { assign to b drive      }
  111.            ChDir('B:\');               { root dir in b          }
  112.            {$I-} MkDir(DirName) {$I+}; { make directory         }
  113.            OK:=(IOresult = 0);         { ok = true if not exist }
  114.            GotoXY(12,12);
  115.            If OK then Begin            { OK is true             }
  116.               ChDir(DirName);          { change to new dir on b }
  117.               WriteLn('New Directory Made');
  118.               DONE:=TRUE
  119.            End
  120.            Else Begin                  { ok = false, dir exists }
  121.               Write('Directory Already Exists'+Chr(7));
  122.               GoToXY(12,13); WriteLn('Press Any Key To Continue');
  123.               Read(Kbd,Chd)
  124.            End; { ik OK }
  125.            ChDir(OldName);             { return to original dir }
  126.         End; { if dirname <> '' }
  127.      End; { if chd was M }
  128.  
  129.      If (Chd='C') or (Chd='c') then Begin  { change a directory     }
  130.         DirName:='';
  131.         GotoXY(2,10); Write('Directory or <CR> to Quit ? ');
  132.         ReadLn(DirName);               { get directory          }
  133.         If DirName<>'' then Begin      { do if not nul          }
  134.            GetDir(0,OldName);          { get current dir in use }
  135.            ChDir('B:\');               { chg to root dir of b   }
  136.            DirName:='B:\'+ DirName;    { assign to b drive      }
  137.            {$I-} ChDir(DirName) {$I+}; { change dir             }
  138.            OK:= (IOresult = 0);        { OK = true if dir exists }
  139.            GotoXY(10,12);
  140.            If OK Then Begin            { dir is exists          }
  141.               WriteLn('Directory Change Made');
  142.               DONE:=TRUE
  143.            End
  144.            Else Begin                  { dir does not exist     }
  145.               Write('Dir Does Not Exist '+Chr(7));
  146.               GotoXY(10,13); Write('Press Any Key To Continue');
  147.               Read(Kbd,Chd)
  148.            End; { if OK }
  149.            ChDir(OldName);             { return to old dir      }
  150.         End; { if dirname <> '' }
  151.      End; { if chd was C }
  152.  
  153.      If (Chd='R') or (Chd='r') then Begin  { change to root dir of b}
  154.         GetDir(0,OldName);             { get existing dir       }
  155.         Chdir('B:\');                  { change to root on B    }
  156.         ChDir(OldName);                { return to existing dir }
  157.         DONE:=TRUE;                    { completed              }
  158.      End; { if chd was R }
  159.  
  160.      If (Chd='S') or (Chd='s') then Begin { show current dir of b  }
  161.         GetDir(2,OldName);             { get the dir of b       }
  162.         GotoXY(10,12); Write('Directory Is: ',OldName);
  163.         GotoXY(10,13); Write('Press Any Key To Continue');
  164.         Read(Kbd,Chd)
  165.      End; { if chd = S }
  166.  
  167.      If (Chd='E') or (Chd='e') then  { exit utility           }
  168.        DONE:=TRUE;
  169.  
  170.    Until DONE;
  171.  
  172.         { Make a little Window and hold for }
  173.         { user to give us a goose..or whatever}
  174.    GotoXY(19,19);
  175.    Get_Abs_Cursor(x,y);            { Get Absolute Cursor Position  }
  176.    MkWin(x,y,x+12,y+3,White);      { Put Window at Cursor    }
  177.    GotoXY(1,1);
  178.    Write('Press a key . . .');
  179.  
  180.    While (Not Keypressed) do;      { Pause until Key pressed }
  181.    While Keypressed do             { Get Ctrl-Home maybe     }
  182.        Read(Kbd,KeyChr);           { Read the users Key      }
  183.        RmWin ;                     { Remove the Window       }
  184.        If KeyChr = Quit_Key then   { If Terminate Key then   }
  185.                    Stay_Xit ;      { remove ourself from  Memory }
  186.    RmWin;
  187. End; { direct }
  188.  
  189.  
  190. {----------------------------------------------------------------------------}
  191. {              P R O C E S S   I N T E R R U P T                             }
  192. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  193. Procedure Process_Intr;
  194.  
  195. {  PURPOSE:  This  procedure  replaces  the  standard  keyboard  interrupt.  If
  196.             anything but <Alt>-F10 is pressed,  the key is  passed  on  to  the
  197.             standard  keyboard  interrupt.  B*U*T  when  <Alt>- F10 is pressed,
  198.             this program takes over.  The variable InUse  is  set  to  TRUE  to
  199.             ensure that this code doesn't try to run "on top of itself " AND to
  200.             indicate  to the Inline code to save/restore the original interrupt
  201.             regs.
  202. }
  203. Begin
  204.           { K e y b o a r d    Interrupt   o c c u r s   here }
  205. {----------------------------------------------------------------------}
  206. {$I Staysave.320}
  207. {----------------------------------------------------------------------}
  208. { Check the Int 16 request function in Ah reg:
  209.                    0 = read character from Keyboard
  210.                    1 = check character available
  211.                    2 = check shift key values
  212. }
  213.  
  214.           { HalfRegs.Ah = 0  This is a Character Request because StaySave }
  215.           { doesnt allow an enter here unless it is!                      }
  216.  
  217.   Intr (User_Int, Regs);             { Use the DOS replaced interrupt}
  218.                                      { Get Key from Keyboard         }
  219.   If (Halfregs.Ah = Our_Char)        { Separate the tests so code    }
  220.                                      { performs efficiently.         }
  221.      then if  (not InUse) then       { Must be OUR key and not busy  }
  222.  
  223.         Begin { Demo }
  224.         InUse := true;                  { "dont clobber saved stack"}
  225.         { Get current Cursor Position    }
  226.         Old_Xpos := WhereX; Old_Ypos := WhereY;
  227.         Direct;
  228. {       Writeln(Lst,'That''s all Folks');{ Test Printer Output if you like }
  229.         GotoXY(Old_Xpos,Old_Ypos);       { Put Cursor Back                 }
  230.         Regs.Ax := $1D00;                { Give Dummy Ctrl Scan Code to    }
  231.                                          {           interrupted program   }
  232.         InUse := false;                  { ok to restore interrupted stack }
  233.         End;  { Demo }
  234.  
  235. {$I Stayrstr.310}                      { Return to Caller }
  236. End ;{Process_Intr}
  237. {-----------------------------------------------------------------------}
  238.  
  239. {The main program installs the new interrupt routine and makes it permanently
  240.  resident as the keyboard interrupt.  The old keyboard interrupt is addressed
  241.  through #67H, so it can still be used.
  242.  
  243. The following dos calls are used:
  244.  
  245.  Function 25 - Install interrupt address
  246.                input al = int number,
  247.                ds:dx = address to install
  248.  Function 35 - get interrupt address
  249.                input al = int number
  250.                output es:bx = address in interrupt
  251.  Function 31 - terminate and stay resident
  252.                input dx = size of resident program obtained from the memory
  253.                allocation block at [Cs:0 - $10 + 3]
  254.  Function 49 - Free Allocated Memory
  255.                input Es = Block Segment to free
  256.  Interrupt 20 - Return to invoking process
  257. }
  258.  
  259. {-----------M A I N    B L O C K---------------------------------------------}
  260. Begin                                  {**main**}
  261.  
  262.   InUse  := false;
  263.   OurDseg:= Dseg;           { Save the Data Segment Address for Interrupts }
  264.   OurSseg:= Sseg;           { Save our Stack Segment for Interrupts        }
  265.  
  266.  
  267.   Terminate_Flag := false ;
  268.  
  269.   {now install the interrupt routine}
  270.  
  271.   SaveRegs.Ax := $35 shl 8 + User_Int;
  272.   Intr($21,SaveRegs);                 {Check to make sure int not already used}
  273.  
  274.   if SaveRegs.Es <> $00 then
  275.     WriteLn ('Interrupt in use -- can''t install Resident Turbo Code')
  276.   else
  277.     begin
  278.  
  279.       { Initialize Your Progam Here since you wont get control again
  280.         until "Our_Char" is entered from the Keyboard.               }
  281.  
  282.       SaveRegs.Ax := $35 shl 8 + Kybrd_Int;
  283.       Intr($21,SaveRegs);        {get the address of keyboard interrupt }
  284.  
  285.       SaveRegs.Ax := $25 shl 8 + User_Int;
  286.       SaveRegs.Ds := SaveRegs.Es;
  287.       SaveRegs.Dx := SaveRegs.Bx;
  288.       Intr($21,SaveRegs);       { set the user-interrupt address to point
  289.                                 { to the keyboard interrupt address }
  290.  
  291.       SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
  292.       SaveRegs.Ds := Cseg;
  293.       SaveRegs.Dx := Ofs(Process_Intr);
  294.       Intr ($21,SaveRegs);        { set the keyboard interrupt to point to
  295.                                   "Process-Intr" above}
  296.  
  297.       User_IntIp := MemW[0:User_Int * 4 ];  { Location of User Interrupt Ip }
  298.       User_IntCs := MemW[0:User_Int * 4 +2];{ Location of User Interrupt Cs }
  299.  
  300.       Writeln('  Directory Utility: Press Alt-F10 to Activate');
  301.  
  302.       {now terminate and stay resident}
  303.                                               { Pass return code of zero    }
  304.       SaveRegs.Ax := $31 shl 8 + 0 ;          { Terminate and Stay Resident }
  305.       SaveRegs.Dx := MemW [Cseg-1:0003] ;     { Prog_Size from Allocation Blk}
  306.       Intr ($21,SaveRegs);
  307.  
  308.     end;
  309.        { END OF RESIDENCY CODE }
  310. end.
  311.