home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / msdos / turbopas / tppop16.arc / POPUP.PAS < prev    next >
Pascal/Delphi Source File  |  1988-10-06  |  5KB  |  150 lines
  1. {$R-,S-,I+,D+,T+,F-,V-,B-,N-,L+ }
  2. Unit PopUp;
  3.  
  4. Interface
  5.  
  6. Uses Dos,Crt;
  7.  
  8. Const
  9.   RightShift = $0100;   { right shift key }
  10.   LeftShift  = $0200;   { left shift key  }
  11.   Control    = $0400;   { control key     }
  12.   ALT        = $0800;   { ALT key         }
  13.  
  14. Function  ReadKey : Char;
  15.  
  16. Function  Installed(OurID : Byte) : Byte;
  17.  
  18. Procedure StayResident(OurID : Byte;Vector : Pointer;PopKey : Word);
  19.  
  20. Procedure ReleaseEnvironment;   { releases the environment memory }
  21.  
  22. Implementation
  23.  
  24. Var
  25.   ProgramVector : Pointer;   { address of popup program           }
  26.   old23h        : Pointer;   { interrupted ^C handler             }
  27.   old24h        : Pointer;   { interrupted critical error handler }
  28.   oldDTA        : Pointer;   { interrupted DTA                    }
  29.   int23h        : Pointer;   { our ^C handler                     }
  30.   int24h        : Pointer;   { our critical error handler         }
  31.   OurDTA        : Pointer;   { our DTA                            }
  32.   PrevBreak     : Boolean;   { previous BREAK status              }
  33.   EnvReleased   : Boolean;
  34.  
  35. Procedure ReleaseBlock(Segment : Word);
  36.  
  37. { Given a segment, releases the memory. }
  38.  
  39.   InLine($07/            { pop   es      }
  40.          $B4/$49/        { mov   ah,49h  }
  41.          $CD/$21);       { int   21h     }
  42.  
  43. Procedure ReleaseEnvironment;
  44.  
  45. { Releases the memory of the environment segment. }
  46.  
  47. Begin
  48.   If Not EnvReleased Then
  49.   Begin
  50.     ReleaseBlock(MemW[PrefixSeg:$002C]); { free the enviornment }
  51.     EnvReleased := True;
  52.   End;
  53. End;
  54.  
  55. Procedure ReleaseProgram; Interrupt;
  56.  
  57. { Releases the program's memory.  We call this when unhooking the program. }
  58.  
  59. Begin
  60.   ReleaseBlock(PrefixSeg);
  61.   ReleaseEnvironment;
  62. End;
  63.  
  64. Function GetDTAVec : Pointer;
  65.  
  66. { returns the segment:offset of the DTA }
  67.  
  68.   InLine($B4/$2F/    { mov   ah,2Fh  }
  69.          $CD/$21/    { int   21h     }
  70.          $89/$D8/    { mov   ax,bx   }
  71.          $8C/$C2);   { mov   dx,es   }
  72.  
  73. Procedure SetDTAVec(DTA : Pointer);
  74.  
  75. { sets the segment:offset of the DTA }
  76.  
  77.   InLine($8C/$D8/     { mov   ax,ds   }
  78.          $5A/         { pop   dx      }
  79.          $1F/         { pop   ds      }
  80.          $50/         { push  ax      }
  81.          $B4/$1A/     { mov   ah,1Ah  }
  82.          $CD/$21/     { int   21h     }
  83.          $1F);        { pop   ds      }
  84.  
  85. Function GetBreakStatus : Boolean;
  86.  
  87.   InLine($B8/$00/$33/     { mov   ax,3300h }
  88.          $CD/$21/         { int   21h      }
  89.          $88/$D0);        { mov   al,dl    }
  90.  
  91. Procedure SetBreakStatus(Status : Boolean);
  92.  
  93.   InLine($5A/             { pop   dx       }
  94.          $B8/$01/$33/     { mov   ax,3301h }
  95.          $CD/$21);        { int   21h      }
  96.  
  97. Procedure CallPopUp; Interrupt;
  98.  
  99. { set some interrupt vectors and run the popup progams }
  100. { restore the interrupt vectors when done              }
  101.  
  102. Begin
  103.   PrevBreak := GetBreakStatus;      { save the BREAK status flag           }
  104.   SetBreakStatus(False);            { turn of BREAK                        }
  105.   OldDTA := GetDTAVec;              { get the current DTA address          }
  106.   SetDTAVec(OurDTA);                { set it to our own address            }
  107.   GetIntVec($23,old23h);            { save the control-break interrupt     }
  108.   GetIntVec($24,old24h);            { save the critical error interrupt    }
  109.   SetIntVec($23,int23h);            { install our control-break interrupt  }
  110.   SetIntVec($24,int24h);            { install our critical error interrupt }
  111.   InLine($FF/$1E/>ProgramVector);   { call the user's procedure            }
  112.   SetIntVec($23,old23h);            { restore the control-break interrupt  }
  113.   SetIntVec($24,old24h);            { restore the critical error interrupt }
  114.   SetDTAVec(OldDTA);                { restore the DTA address              }
  115.   SetBreakStatus(PrevBreak);        { restore the original BREAKing status }
  116. End;
  117.  
  118. Function ReadKey : Char;
  119.  
  120. Begin
  121.   Repeat
  122.     InLine($CD/$28);    { int  28h }
  123.   Until Keypressed;
  124.   ReadKey := crt.ReadKey;
  125. End;
  126.  
  127. Function Installed(OurID : Byte) : Byte; External;
  128.  
  129. Procedure InitializePopUp(OurID : Byte;PopKey : Word); External;
  130.   { sets interrupt vectors }
  131. {$L tpop.obj}
  132.  
  133. Procedure StayResident(OurID : Byte;Vector : Pointer;PopKey : Word);
  134.  
  135. { saves some info and Terminated and Stays Resident }
  136.  
  137. Begin
  138.   OurDTA := GetDTAVec;              { save our DTA address              }
  139.   GetIntVec($23,int23h);            { save our control-break interrupt  }
  140.   GetIntVec($24,int24h);            { save our critical error interrupt }
  141.   ProgramVector := Vector;          { save the user program address     }
  142.   InitializePopUp(OurID,PopKey);    { install our interrupt vectors     }
  143.   Keep(0);                          { terminate and stay resident       }
  144. End;
  145.  
  146. Begin
  147.   CheckBreak := False;              { ignore the control break key }
  148.   EnvReleased := False;             { environment not yet released }
  149. End.
  150.