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