home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 05 / praxis / tsr.pas < prev    next >
Pascal/Delphi Source File  |  1990-02-13  |  4KB  |  149 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      TSR.PAS                           *)
  3. (* ------------------------------------------------------ *)
  4. {$R-,S-,I-,V-,B-,N-}
  5.  
  6. UNIT TSR;
  7.  
  8. INTERFACE USES Dos;
  9.  
  10. PROCEDURE SaveInt16;
  11. PROCEDURE Int16;
  12. FUNCTION AlreadyLoaded(ID : BYTE) : BOOLEAN;
  13. FUNCTION Segment(ID : BYTE) : WORD;
  14. FUNCTION PopUpInstalled(PopUp : Pointer;
  15.                         HotKey, HeapParas : WORD) : BOOLEAN;
  16. PROCEDURE MakeResident(ID : BYTE);
  17. PROCEDURE ReleaseBlock(Segment : WORD);
  18. PROCEDURE RemoveTSR;
  19.  
  20. IMPLEMENTATION
  21.  
  22. VAR
  23.   SaveSP,
  24.   SaveSS,
  25.   PopUpSS,
  26.   PopUpSP,
  27.   HotKey_      :WORD;
  28.   TempInt16,
  29.   SaveInt1B,
  30.   PopUp_       :Pointer;
  31.   InUse        :BOOLEAN;
  32.   ProgramID    :BYTE;
  33.  
  34. {$L TSR.OBJ}
  35.  
  36.   PROCEDURE SaveInt16; EXTERNAL;
  37.   PROCEDURE Int16; EXTERNAL;
  38.  
  39.   FUNCTION AlreadyLoaded(ID : BYTE) : BOOLEAN;
  40.   VAR
  41.     Regs   : Registers;
  42.     IDMask : LongInt;
  43.   BEGIN
  44.     WITH Regs DO BEGIN
  45.       AH := $F0;
  46.       BX := 0;
  47.       CX := 0;
  48.       Intr ($16, Regs);
  49.       IDMask := LongInt(CX) SHL 16 + BX;
  50.     END;
  51.     AlreadyLoaded := IDMask AND
  52.                      (LongInt(1) SHL Pred(ID)) <> 0;
  53.   END;
  54.  
  55.   FUNCTION Segment(ID : BYTE) : WORD;
  56.   VAR
  57.     Regs : Registers;
  58.   BEGIN
  59.     WITH Regs DO BEGIN
  60.       AH := $F1;
  61.       AL := ID;
  62.       BX := 0;
  63.       Intr ($16, Regs);
  64.       Segment := BX;
  65.       END
  66.    END;
  67.  
  68.   FUNCTION PopUpInstalled(PopUp :Pointer;
  69.                         HotKey, HeapParas : WORD) : BOOLEAN;
  70.   CONST
  71.     Reserved = $1000;
  72.   VAR
  73.     MaxParas : WORD;
  74.     NextFree : ^WORD;
  75.  
  76.     FUNCTION ParasNeeded : WORD;
  77.     { ermittelt den Speicherbedarf des aktuellen Programms }
  78.     { für Code-, Daten- und Stack-Segment sowie des        }
  79.     { Environment-Bereichs in Paragraphen                  }
  80.     VAR
  81.       EnvironSeg, EnvironSize : WORD;
  82.     BEGIN
  83.       EnvironSeg  := WORD(Ptr(PrefixSeg, $002C)^);
  84.       EnvironSize := WORD(Ptr(EnvironSeg - 1, $0003)^);
  85.       ParasNeeded := Succ(Seg(HeapOrg^) -
  86.                     - PrefixSeg + EnvironSize);
  87.     END;
  88.  
  89.   BEGIN
  90.     PopUpInstalled := FALSE;     { Mißerfolg bei Rückkehr! }
  91.     MaxParas  := WORD(Ptr(PrefixSeg - 1, $0003)^);
  92.     NextFree := Ptr(PrefixSeg, $0002);
  93.     IF ParasNeeded + HeapParas + Reserved > MaxParas THEN
  94.       Exit;                         {  zu wenig Speicher!  }
  95.     FreePtr := Ptr(Seg(HeapOrg^) + HeapParas - $1000, 0);
  96.     NextFree^ := Seg(HeapOrg^) + HeapParas;
  97.     Release(HeapOrg);        {  gesamten Heap freimachen!  }
  98.     PopUp_  := PopUp;      { Installationsparameter sichen }
  99.     HotKey_ := HotKey;
  100.     PopUpInstalled := TRUE;{ Installation war erfolgreich! }
  101.   END;
  102.  
  103.   PROCEDURE MakeResident(ID : BYTE);
  104.   VAR
  105.     SavePtr :^Pointer;
  106.   BEGIN
  107.     ProgramID := ID;              { Identify-Maske sichern }
  108.     SavePtr   := @SaveInt16;
  109.     SetIntVec ($00, SaveInt00);    { Vektoren restaurieren }
  110.     SetIntVec ($1B, SaveInt1B);
  111.     SetIntVec ($23, SaveInt23);
  112.     SetIntVec ($24, SaveInt24);
  113.     GetIntVec ($16, SavePtr^);     { Int16-Vektor holen... }
  114.     SetIntVec ($16, @Int16);
  115.     InUse := FALSE;
  116.     Keep(0);                    { Programm resident machen }
  117.   END;
  118.  
  119.   PROCEDURE ReleaseBlock(Segment : WORD);
  120.   VAR
  121.     Regs : Registers;
  122.   BEGIN
  123.     WITH Regs DO BEGIN
  124.       ES := Segment;
  125.       AH := $49;  {  DOS-Funktion "Free Allocated Memory"  }
  126.       MsDos(Regs);
  127.     END;
  128.   END;
  129.  
  130.   PROCEDURE RemoveTSR;
  131.   VAR
  132.     P : ^Pointer;
  133.   BEGIN
  134.     P := @SaveInt16;
  135.     TempInt16 := P^;
  136.     IF MemW[PrefixSeg:$2C] <> 0 THEN
  137.                             {  Umgebungsbereich freigeben  }
  138.       ReleaseBlock(MemW[PrefixSeg:$2C]);
  139.     ReleaseBlock(PrefixSeg);
  140.                             {  Programmspeicher freigeben  }
  141.   END;
  142.  
  143. BEGIN
  144.   PopUpSS := SSeg;               { die Stapelwerte merken  }
  145.   PopUpSP := SPtr + 4;         { Sprung  berücksichtigen!  }
  146.   GetIntVec ($1B, SaveInt1B); { Ctrl-Break-Vektor sichern  }
  147. END.
  148. (* ------------------------------------------------------ *)
  149. (*                 Ende von TSR.PAS                       *)