home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / timer / qt / qt.pas
Encoding:
Pascal/Delphi Source File  |  1988-02-29  |  11.6 KB  |  415 lines
  1. {
  2.     Program:     QT (Quick Time)
  3.  
  4.     Version:     1.00
  5.     Date:        January 10, 1988
  6.  
  7.     Language:    Borland Turbo Pascal v4.0
  8.     Environment: IBM/PC compatible, MS-DOS v2.0 or higher
  9.  
  10.     A memory-resident program to display the current time. The program was
  11.     tested on an 8Mhz Kaypro PC, with a Hercules Monochrome Graphics Adapter.
  12.  
  13.     Copyright (c) 1988 by Scott Robert Ladd.
  14.  
  15.     Permission is granted to use this program, or portions thereof, for
  16.     both commercial and non-commercial purposes. All other rights are
  17.     reserved to the original author.
  18. }
  19. {$M 1024,0,0}
  20. {$V-,R-,S-,B-}
  21.  
  22. program Receipt; uses Crt, Dos;
  23.  
  24. type
  25.     Screen = array [0..24,0..79] of word;
  26.  
  27. var
  28.     { storage for storing the old addresses of captured interrupts}
  29.     Int09_Vec : pointer;
  30.     Int11_Vec : pointer;
  31.     Int28_Vec : pointer;
  32.  
  33.     { the codes used in CX to determine if this TSR is already installed}
  34.     InstCode1 : word;
  35.     InstCode2 : word;
  36.  
  37.     { in undocumented InDos flag, which indicates when DOS can be interrupted}
  38.     InDosFlag  : ^word;
  39.  
  40.     { the word in low memory where the Shift-Alt-Ctrl status is stored }
  41.     Kbd_Status : word absolute $0000:$0417;
  42.  
  43.     { the equipment list word in low memory }
  44.     EquipList  : word absolute $0000:$0410;
  45.  
  46.     { set to true when TSR is already activated }
  47.     Busy : boolean;
  48.  
  49.     { register pack used when calling system interrupts with Intr }
  50.     Regs : Registers;
  51.  
  52.     { the physical and stored original video screens }
  53.     Video_Display : ^Screen;
  54.     Old_Display   : Screen;
  55.  
  56.     { original video mode }
  57.     Old_Mode      : byte;
  58.  
  59.     { original cursor position }
  60.     Old_X, Old_Y   : byte; { from WhereX and WhereY }
  61.     VCoord, HCoord : byte; { from the 6845 }
  62.  
  63.     { old cursor type to be restored when cursor is turned back on }
  64.     OldCursor     : word;
  65.  
  66.     { variables to save both the Turbo stack and the original stack }
  67.     TurboSS, TurboSP : word;
  68.     OrigSS : word;
  69.  
  70. const
  71.     { the keystroke which activates this TSR -- ALT & Left-SHIFT}
  72.     Activate : word = $000A;
  73.  
  74.     { set of valid text modes }
  75.     TextModes : set of byte = [0,1,2,3,7];
  76.  
  77. {
  78. CallInt : Calls an interrupt function based on a a pointer containing the
  79.           function address.
  80. }
  81. procedure CallInt(p : pointer);
  82. begin
  83.      inline($9C/          { PUSHF           }
  84.             $FF/$5E/$04); { CALL FAR [BP+4] }
  85. end;
  86.  
  87. {
  88. GetMode : Returns the current video display mode.
  89. }
  90. function GetMode : byte;
  91. begin
  92.     Regs.AX := $0F00;
  93.     Intr($10,Regs);
  94.     GetMode := Regs.AL;
  95. end;
  96.  
  97. {
  98. SetMode : Sets the video display mode.
  99. }
  100. procedure SetMode (Mode : byte);
  101. begin
  102.     Regs.AH := 0;
  103.     Regs.AL := Mode;
  104.     Intr($10,Regs);
  105. end;
  106.  
  107. {
  108. SaveScr : Loads the current display into an internal buffer for restoration
  109.           when the TSR exits.
  110. }
  111. procedure SaveScr;
  112. begin
  113.     { save the current video mode }
  114.     Old_Mode := GetMode;
  115.     { Save the cursor (BIOS) }
  116.     Old_X := WhereX;
  117.     Old_Y := WhereY;
  118.     { Save the cursor (6845) }
  119.     Port[$03B4] := 14;
  120.     HCoord := Port[$03B5];
  121.     Port[$03B4] := 15;
  122.     VCoord := Port[$03B5];
  123.     { Make a copy of the original display buffer }
  124.     Old_Display := Video_Display^;
  125. end; {SaveScr}
  126.  
  127. {
  128. RestScr : Restores the screen previously saved by SaveScr.
  129. }
  130. procedure RestScr;
  131. begin
  132.     { restore the video mode }
  133.     SetMode(Old_Mode);
  134.     { Yes, I know this causes "snow" on CGA systems -- but only for a very
  135.       split second when restoring the old display. }
  136.     Video_Display^ := Old_Display;
  137.     { Restore the cursor for the BIOS }
  138.     GotoXY(Old_X,Old_Y);
  139.     { Restore the cursor for the 6845 }
  140.     Port[$03B4] := 14;
  141.     Port[$03B5] := HCoord;
  142.     Port[$03B4] := 15;
  143.     Port[$03B5] := VCoord;
  144. end; {RestScr}
  145.  
  146. {
  147. CursorOn : Restores the cursor to the definition stored in OldCursor.
  148. }
  149. procedure CursorOn;
  150. begin
  151.    Regs.AH := 1;
  152.    Regs.CX := OldCursor;
  153.    Intr($10,Regs);
  154. end;
  155.  
  156. {
  157. CursorOff : Stores the current cursor definition in OldCursor, and then
  158.             makes the cursor invisible.
  159. }
  160. procedure CursorOff;
  161. begin
  162.     Regs.AH := 3;
  163.     Intr($10,Regs);
  164.     OldCursor := Regs.CX;
  165.  
  166.     Regs.AH := 1;
  167.     Regs.CX := $2000; { bit 5 of CH set on, blanks cursor! }
  168.     Intr($10,Regs);
  169. end;
  170.  
  171. {
  172. Process: This is the main program, where the TSR actually does its work.
  173.          For this example, it displays the time continuously in the
  174.          upper left hand corner of the screen, until a key is pressed.
  175. }
  176. procedure Process;
  177. var
  178.     Hr, Min, Sec, Mil : word;
  179.     Ch : char;
  180. begin
  181.     CursorOff;
  182.     repeat
  183.         GetTime(Hr,Min,Sec,Mil);
  184.         GotoXY(1,1);
  185.         Writeln('┌──────────┐');
  186.         Write('│ ',Hr:2,':');
  187.         if Min > 9 then
  188.             Write(Min:2)
  189.           else
  190.             Write('0',Min:1);
  191.         if Sec > 9 then
  192.             Write(':',Sec:2)
  193.           else
  194.             Write(':0',Sec:1);
  195.         Writeln(' │');
  196.         Writeln('└──────────┘');
  197.     until KeyPressed;
  198.     Ch := ReadKey;
  199.     CursorOn;
  200. end; {Process}
  201.  
  202. {
  203. DeInstall : sets the interrupt vectors back to their original settings, and
  204.             removes the TSR from memory.
  205. }
  206. procedure DeInstall;
  207. var
  208.     EnvSegPtr : ^word;
  209. begin
  210.     { save the interrupted program's stack segment and pointer }
  211.     { restore QT's stack segment and pointer }
  212.     inline (
  213.         $8C/$16/OrigSS/     { MOV  OrigSS, SS }
  214.         $8E/$16/TurboSS/    { MOV  SS, TurboSS }
  215.         $8B/$26/TurboSP     { MOV  SP, TurboSP }
  216.         );
  217.  
  218.     { Restore the original cursor and screen }
  219.     CursorOn;
  220.     RestScr;
  221.  
  222.     SetIntVec($28,Int28_Vec); { restore INT 28 (DOS idle)}
  223.     SetIntVec($11,Int11_Vec); { restore INT 11 (BIOS equipment)}
  224.     SetIntVec($09,Int09_Vec); { restore INT 9 (BIOS keyboard)}
  225.  
  226.     { make a pointer to the Environment Segment stored in the PSP }
  227.     EnvSegPtr := Ptr(PrefixSeg,44);
  228.  
  229.     { deallocate the local environment block }
  230.     Regs.AX := $4900;
  231.     Regs.ES := EnvSegPtr^;
  232.     Intr($21,Regs);
  233.  
  234.     { deallocate this program's memory block }
  235.     Regs.AX := $4900;
  236.     Regs.ES := PrefixSeg;
  237.     Intr($21,Regs);
  238.  
  239.     { restore the stack of the interrupted program }
  240.     inline (
  241.         $8E/$16/OrigSS     { MOV  SS, OrigSS }
  242.         );
  243.  
  244.     { exit to DOS }
  245.     Halt(0);
  246. end;
  247.  
  248. {
  249. Int28 : This is the DOS idle interrupt, called when DOS isn't doing anything.
  250.         We capture it, and every time it's invoked, we check to see if the
  251.         "hot key" has been pressed. This is an undocumented DOS interrupt.
  252. }
  253. procedure Int28;
  254. interrupt;
  255. begin
  256.     inline($FA);        {CLI -- stop interrupts for a while}
  257.     CallInt(Int28_Vec); { call the original interrupt function first }
  258.     { if the TSR is active, and the hot key is pressed, deinstall TSR }
  259.     if (Busy) and (Kbd_Status = Activate) then
  260.       begin
  261.         DeInstall;
  262.       end;
  263.     { if the TSR isn't active, and the hot key is pressed, and ...}
  264.     if (not Busy) and (Kbd_Status = Activate) {and (GetMode in TextModes)} then
  265.       begin
  266.         Busy := true; { the TSR is now marked as activated }
  267.         { save the interrupted program's stack segment and pointer }
  268.         { restore QT's stack segment and pointer }
  269.         inline (
  270.             $8C/$16/OrigSS/     { MOV  OrigSS, SS }
  271.             $8E/$16/TurboSS/    { MOV  SS, TurboSS }
  272.             $8B/$26/TurboSP     { MOV  SP, TurboSP }
  273.             );
  274.         SaveScr; { save the current display }
  275.         Process; { The actual TSR }
  276.         RestScr; { restore the display }
  277.         { restore the stack of the interrupted program }
  278.         inline (
  279.             $8E/$16/OrigSS     { MOV  SS, OrigSS }
  280.             );
  281.         Busy := false; { the TSR is no longer active }
  282.       end;
  283.     inline($FB); {STI -- restart interrupts}
  284. end; {Int28}
  285.  
  286. {
  287. Int11 : Is used normally by the system to retrieve the equipment list word.
  288.         We use it to determine if this TSR is already loaded; if CX is equal
  289.         to InstCode1, we set it to InstCode2, which is then returned. Since
  290.         CX is not used by Int11, and we load the returned AX register with
  291.         the equipment list word from low memory, the operation should be
  292.         transparent to other programs.
  293. }
  294. procedure Int11(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : word);
  295. interrupt;
  296. begin
  297.     { if the CX register contains the special installation check code,
  298.       return the OK in CX }
  299.     CallInt(Int11_Vec);
  300.     if (CX = InstCode1) then
  301.          CX := InstCode2;
  302.     inline($FB); {STI}
  303.     { load AX with equipment list word (which is what int 11 normally does)}
  304.     AX := EquipList;
  305. end; {Int11}
  306.  
  307. {
  308. Int09 : This is the standard BIOS keyboard function interrupt. We chain to
  309.         it, and watch for the "hot_key" to appear.
  310. }
  311. procedure Int09;
  312. interrupt;
  313. begin
  314.     inline($FA);        {CLI -- stop interrupts for a while}
  315.     CallInt(Int09_Vec); { call the original keyboard interrupt }
  316.     { if the TSR is active, and the hot key is pressed, deinstall TSR }
  317.     if (Busy) and (Kbd_Status = Activate) then
  318.       begin
  319.         DeInstall;
  320.       end;
  321.     { if the TSR isn't active, the hot key is pressed, and DOS isn't busy...}
  322.     if (not Busy) and (Kbd_Status = Activate)
  323.     and (InDosFlag^ = 0) {and (GetMode in TextModes)} then
  324.       begin
  325.         Busy := true;  { flag TSR as active }
  326.         { save the interrupted program's stack segment and pointer, and }
  327.         { restore QT's stack segment and pointer }
  328.         inline (
  329.             $8C/$16/OrigSS/     { MOV  OrigSS, SS }
  330.             $8E/$16/TurboSS/    { MOV  SS, TurboSS }
  331.             $8B/$26/TurboSP     { MOV  SP, TurboSP }
  332.             );
  333.         SaveScr; { save the current display }
  334.         Process; { The actual TSR }
  335.         RestScr; { restore the display }
  336.         { restore the stack of the interrupted program }
  337.         inline (
  338.             $8E/$16/OrigSS     { MOV  SS, OrigSS }
  339.             );
  340.         Busy := false; {TSR is no longer active }
  341.       end;
  342.     inline($FB); {STI}
  343. end; {Int09}
  344.  
  345. {
  346. Initialize : This function checks to see if the TSR is already resident before
  347.              proceding with installation. It then chains to the three captured
  348.              interrupts (hex 28, 11, and 9), and initializes some global
  349.              variables.
  350. }
  351. function Initialize : boolean;
  352. begin
  353.     { assign the special activation test codes }
  354.     InstCode1 := $5154; {QT}
  355.     InstCode2 := $4F4B; {OK}
  356.  
  357.     { check to see if TSR is already installed }
  358.     Regs.CX := InstCode1;
  359.     Intr($11,Regs);
  360.     if (Regs.CX = InstCode2) then
  361.        begin
  362.          Initialize := false;
  363.          exit;
  364.        end;
  365.  
  366.     { get the video mode, and select the proper buffer for save / restore }
  367.     if (7 = GetMode) then
  368.         Video_Display := Ptr($B000,0)
  369.       else
  370.         Video_Display := Ptr($B800,0);
  371.  
  372.     { capture INT 28 (DOS idle)}
  373.     GetIntVec($28,Int28_Vec);
  374.     SetIntVec($28,@Int28);
  375.  
  376.     { capture INT 11 (BIOS equipment)}
  377.     GetIntVec($11,Int11_Vec);
  378.     SetIntVec($11,@Int11);
  379.  
  380.     { capture INT 9 (BIOS keyboard)}
  381.     GetIntVec($09,Int09_Vec);
  382.     SetIntVec($09,@Int09);
  383.  
  384.     { locate the DOS InDOS flag }
  385.     Regs.AX := $3400;
  386.     Intr($21,Regs);
  387.     InDosFlag := Ptr(Regs.ES,Regs.BX);
  388.  
  389.     { save the location and status of QT's stack }
  390.     TurboSS := SSeg;
  391.     TurboSP := SPtr;
  392.  
  393.     Busy := false;
  394.  
  395.     Initialize := true;
  396. end; {Initialize}
  397.  
  398. begin
  399.     { a quick heading }
  400.     Writeln('QT -- Quick Time Display (a TSR)');
  401.     Writeln;
  402.  
  403.     if Initialize then
  404.       begin
  405.         Writeln('Program installed');
  406.         Keep(0); { Turbo Pascal TSR call }
  407.       end
  408.     else
  409.       begin
  410.         Writeln(^G,'Unable to install program. Sorry!');
  411.         Exit;
  412.       end;
  413.  
  414. end. {QT}
  415.