[Back to TSR SWAG index] [Back to Main SWAG index] [Original]

    {
    TSR.PAS
      Sample TSR application written in Turbo Pascal.
      IMPORTANT!
      This TSR operates only in TEXT mode, and, as
      written, supports only 80 x 25 sized screens
      (not 43- or 50- line display modes).

      This TSR will only operate on DOS 3.x or newer
      versions of DOS.

      Use this code as an example to write your own TSR code.
      Modify the $M compiler directive, below, to specify
      the maximum stack size, minimum heap and maximum heap
      required for your TSR application.

      Please see the text and other source comments
      for important restrictions.

      TSRs can be DANGEROUS, so be careful.
    }

    {$S-}
    {$M 3072, 0, 512}
    uses
      Crt, Dos;

    type
      { Defines an array to store the screen image.
      For greater efficiency, your code may want to save only
      the portion of the screen that is changed by your TSR
      code. This implementation saves the entire screen image,
      at popup time, for the greatest flexibility. }
      TSavedVideo=Array[0..24, 0..79] of Word;
      PSavedVideo=^TSavedVideo;

    { The following items define the TSR's identification
    string. }
    type
      String8=String[8];
    const
      IdStr1:String8='TP7RTSR';
      IdStr2:String8='TSRInUse';

    var
      CPURegisters: Registers;
        { General register structure for Intr calls. }
      CursorStartLine: Byte;
        { Stores cursor shape information. }
      CursorEndLine: Byte;
        { Stores cursor shape information. }
      DiskInUse: Word;
        { Tracks INT 13 calls in progress. }
      MadeActive: Boolean;
        { TRUE if this TSR has been asked to pop up. }
      OurSP: Word;
      OurSS: Word;
        { Saved copies of our SS and SP registers. }
      PInt09: Pointer;
        { Saved address of keyboard handler. }
      PInt12: Pointer;
        { Saved address of GetMemorySize interrupt. }
      PInt1B: Pointer;
        { Ctrl-Break interrupt address. }
      PInt24: Pointer;
        { DOS Critical error handler. }
      PInt28: Pointer;
        { Saved address of background task scheduler. }
      PInt1C: Pointer;
        { Saved address of timer handler. }
      PInDosFlag: ^Word;
        { Points to DOS's InDos flag. }
      VideoMem: PSavedVideo;
        { Points to actual video memory area. }
      SavedVideo:TSavedVideo;
        { Stores the video memory when TSR is popped up. }
      SavedWindMin: Word;
       { Holds saved copy of WindMin for restoring window. }
      SavedWindMax: Word;
       { Holds saved copy of WindMax for restoring window. }
      SavedSS,
      SavedSP: Word;
       { Saves caller stack registers; must be global
       to store in fixed memory location, not on local
       stack of interrupted process. }
      SavedX,
      SavedY: Word;
        { Stores X, Y cursor prior to TSR popup }
        { for restoration when TSR goes away. }
      TempPtr: Pointer;
        { Used internally to DoUnInstall. }
      TSRInUse: Boolean;
        { Set TRUE during processing to avoid double
        activation. }

    procedure SaveDisplay;
    { Copies the content of video memory to an internal
      array structure. Saves the cursor location and cursor
      shape definitions. }
    var
      CursorLines: Byte;
    begin
      { Save cursor location. }
      SavedX := WhereX;
      SavedY := WhereY;
      { Saved existing window values. }
      SavedWindMin := WindMin;
      SavedWindMax := WindMax;

      { Get and save current cursor shape. }
      with CPURegisters do
      begin
        AH := $03;
        BH := 0;
        Intr($10, CPURegisters);
        CursorStartLine := CH;
        CursorEndLine:= CL;
      end;

      { Get equipment-type information. If Monochrome
        adapter in use, then point to $B000; otherwise use the
        color memory area. }
      Intr( $11, CPURegisters );
      if  ((CPURegisters.AX shr 4) and 7) = 3 then
      begin
        VideoMem := Ptr( $B000, 0 );
        CursorLines := 15;
      end
      else
      begin
        VideoMem := Ptr( $B800, 0 );
        CursorLines := 7;
      end;
      SavedVideo := VideoMem^;

      { Change cursor shape to block cursor. }
      with CPURegisters do
      begin
        AH := $01;
        CH := 0;
        CL := CursorLines;
        Intr($10, CPURegisters);
      end;

    end; { SaveDisplay }

    procedure RestoreDisplay;
    { Always called sometime after calling SaveDisplay.
      Restores the video display to its state prior to the
      TSR popping up. }
    begin
      { Restore screen content. }
      VideoMem^ := SavedVideo;

      { Restore cursor shape. }
      with CPURegisters do
      begin
        AH := $01;
        CH := CursorStartLine;
        CL := CursorEndLine;
        Intr($10, CPURegisters);
      end;

      { Resize window so the GotoXY (below) will work. }
      Window (Lo(SavedWindMin)+1, Hi(SavedWindMin)+1,
              Lo(SavedWindMax)+1, Hi(SavedWindMax)+1);
      Gotoxy ( SavedX, SavedY );

    end; { Restore Display }

    procedure TrapCriticalErrors;
    assembler;
    { INT 24H }
    {
    This handler is enabled only while the TSR is popped
    up on-screen.

    This handler exists solely to catch any DOS
    critical errors and is a crude method of doing so. Since
    this routine does nothing, any critical errors that
    occur while the TSR is popped up are ignored--which
    could be very dangerous. Also, if another TSR or ISR
    pops up after this one, it may get the critical
    error that was intended for this TSR.

    NOTE: Normally, this could be an "interrupt" type
    procedure. However, Turbo Pascal pushes and then pops
    all registers prior to the IRET instruction. By writing
    this as an assembler routine, this generates the IRET
    directly, followed by one superfluous RET instruction
    generated by the assembler, resulting in substantial
    code savings.
    }
    asm
      IRET
    end; { TrapCriticalErrors }

    procedure CBreakCheck;
    assembler;
    { INT 1BH }

    { This routine results in a no operation; when hooked to
    the INT 1B Ctrl-Break interrupt handler, it causes
    nothing to happen when Ctrl-Break or Ctrl-C are pressed.
    This routine is hooked only when the TSR is popped up. }
    asm
            IRET
    end; { CBreakCheck }

    function GetKey : Integer;
    { Pauses for input of a
    single keystroke from the keyboard and returns the ASCII
    value. In the case where an Extended keyboard key is
    pressed, GetKey returns the ScanCode + 256. The Turbo
    Pascal ReadKey function is called to perform the
    keystroke input. This routine returns a 0 when an Extended
    key has been typed (for example, left or right arrow)
    and we must read the next byte to determine the Scan
    code.
    }
    var
      Ch : Char;
    begin
      { While waiting for a key to be pressed, call
      the INT $28 DOS Idle interrupt to allow background
      tasks a chance to run. }
      repeat
        asm
          int $28
        end;
      until KeyPressed;
      Ch := ReadKey;
      If Ord(Ch) <> 0 then
        GetKey := Ord(Ch)        { Return normal ASCII value. }
      else
        { Read the DOS Extended SCAN code that follows. }
        GetKey := Ord(ReadKey) + 256;
    end;{GetKey}

    procedure  DoPopUpFunction;
    { This procedure is the "guts" of the popup
      application. You can code your own application here, if
      you want. Be sure to read the text for important
      restrictions on what can be written in a TSR.

      As implemented here, this popup displays a table
      of ASCII values.
    }

    const
      UpperLeftX=10;
      UpperLeftY=5;
        { Define upper-left corner of TSR's popup window. }

      LowerLeftX=70;
      LowerRightY=20;
        { Define lower-right corner of TSR's popup window. }

      Width=LowerLeftX - UpperLeftX + 1;
      Height=LowerRightY - UpperLeftY + 1;
        { Calculated width and height of popup window. }
      MinX=6;
        { Distance from left edge to display ASCII table. }
      RightEdge=8;
        { Marks the right edge (Width-RightEdge) of table. }
      MinY=4;
        { Distance from top of window to start ASCII Table. }
      ValuesPerLine=Width-8 - MinX;
        { Computed number of ASCII values in each line. }
      NumLines=255 div ValuesPerLine;
        { Computed number of lines in the ASCII table. }
      KEY_LEFTARROW = 331;
        { Keystroke values for extended keyboard codes. }
      KEY_RIGHTARROW = 333;
      KEY_DOWNARROW = 336;
      KEY_UPARROW = 328;
      KEY_ESCAPE = 27;
      KEY_ENTER = 13;

    procedure PutChar( X, Y: Integer; ChCode: Char );
    { Writes the single character ChCode to the screen
    at (X, Y), where (X, Y) is relative to the TSR popup
    window. This routine is used for displaying the ASCII
    table because the usual Pascal Write() translates ASCII
    7 to a bell ring, and ASCII 13 and 10 to carriage return
    and line feed. By using the PC BIOS routine directly, we
    bypass Pascal's translation of these characters. }
    begin
      with        CPURegisters  do
      begin
        { Move the cursor to adjusted (X, Y). }
        AH := $02;
        BH := 0;
        DH := UpperLeftY + Y - 2;
        DL := UpperLeftX + X - 2;
        Intr($10, CPURegisters);

        { Output the character to the current cursor location. }
        AH := $09;
        AL := byte(ChCode);
        BH := 0;
        BL := 3 shl 4 + 14;
          { Background=color 3; Foreground=color 14 }
        CX := 1;
        Intr($10, CPURegisters);
      end;
    end; {PutChar}

    var
      ASCIICode: Integer;
        { Computed from X, Y location in table. }
      I: Integer;
        { For loop index variable. }
      TextLine: String[Width];
        { Buffer to hold width of window's text. }
      X, Y: Integer;
        { Tracks cursor location in ASCII table. }
      Ch : Integer;
        { Holds the keystroke typed. }

    begin {DoPopUpFunction}
      { Select White text on Cyan background for
      TSR's text (except table). }
      TextColor( White );
      TextBackground( Cyan );

      { Set up a viewing window; makes calculation
      of X, Y easier. }
      Window(UpperLeftX, UpperLeftY, LowerLeftX, LowerRightY);

      { Enclose the window by drawing a border around
      it and filling the interior with blanks. }
      FillChar( TextLine[1], Width, ' ');
      TextLine[0] := Chr( Width );
      TextLine[1] := chr( 179 );
      TextLine[Width] := chr( 179 );

      for I := 2 to Height - 2 do
      begin
        Gotoxy(1, I);
        Write( TextLine );
      end;

      FillChar( TextLine[1], Width, Chr(196));
      TextLine[1] := Chr( 218 );
      TextLine[Width] := Chr( 191 );
      Gotoxy( 1 , 1 );
      Write( TextLine );

      TextLine[1] := Chr( 192 );
      TextLine[Width] := Chr( 217 );
      Gotoxy ( 1, Height - 1 );
      Write( TextLine );

      { Display window title }
      Gotoxy ( Width div 2 -10, 2 );
      Write( 'Table of ASCII Values' );

      { Draw the ASCII table on the display }
      X := MinX;
      Y := MinY;
      for I := 0 to 255 do
      begin
        PutChar( X, Y, Chr(I) );
        Inc(X);
        If        X = (Width-RightEdge)  then
        begin
          Inc( Y );
          X := MinX;
        end;
      end;

      Gotoxy ( Width div 2 - 20 , 11 );
      Write('Use arrow keys to navigate; Esc when done');
      X := MinX; Y := MinY;
      repeat
        { Compute ASCII code and value at X, Y }
        ASCIICode := (X-MinX + (Y-MinY)*ValuesPerLine);
        Gotoxy (Width div 2 - 11 , 13);
        { NOTE: This allows display of
        "ASCII codes" greater than 256 if cursor
        moves into blank area in table. }
        Write('Character= ', '  ASCII=',ASCIICode:3);
        PutChar(Width div 2, 13, Chr(ASCIICode));
        { Display that value, below }
        Gotoxy ( X, Y );
        Ch := GetKey;
        Case  Ch  Of
          KEY_LEFTARROW:  if  X > MinX  then  Dec(X);
          KEY_RIGHTARROW:
            if  X < (Width - RightEdge - 1)  then  Inc(X);
          KEY_DOWNARROW: if  Y < (MinY+NumLines)  then Inc(Y);
          KEY_UPARROW:  if          Y > MinY  then    Dec(Y);
        end;
      until  Ch = 27;

      { End of TSR popup code. }
    end; {DoPopUpFunction}

    procedure RunPopUp;
    { Switches from system stack to TSR's stack. Calls
    DoPopUpFunction to run the actual TSR application. This
    keeps all the ugly details separate from the
    application. Note that while the TSR is up on the
    screen, and only while the TSR is up, we trap the
    Ctrl-Break and DOS critical errors interrupt. We do
    nothing when we see them except return, thereby ignoring
    the interrupts. }
    begin
     { Switch stacks. }
       asm
         CLI
       end;
       SavedSS := SSeg;
       SavedSP := SPtr;
       asm
         MOV   SS, OurSS
         MOV   SP, OurSP
         STI
       end;
       GetIntVec( $1B, PInt1B );
         { Disable Ctrl-Break checking. }
       SetIntVec( $1B, @CBreakCheck );
       GetIntVec( $24, PInt24 );
         { Trap DOS critical errors. }
       SetIntVec( $24, @TrapCriticalErrors );
       SaveDisplay;

       DoPopUpFunction;

       RestoreDisplay;
       SetIntVec( $24, PInt24 );
         { Reenable DOS critical error trapping. }
       SetIntVec( $1B, PInt1B );
         { Reenable Ctrl-C trapping. }
       { Restore stacks. }
       asm
         CLI
         MOV   SS, SavedSS
         MOV   SP, SavedSP
         STI
       end;
    end; {RunPopUp}

    procedure BackgroundInt;
    interrupt;
    { INT 28H }
    { This routine is hooked in the DOS INT 28H chain,
    known variously as the DOSOK or DOSIdle interrupt. The
    idea is that when applications are doing nothing except
    waiting for a keystroke, they can call INT 28
    repeatedly. INT 28 runs through a chain of applications
    that each get a crack at running.

    The keyboard interrupt handler watches for the
    magic TSR popup key. Some of the time it runs the TSR
    popup directly; when DOS is doing something, however, it
    can't run the TSR. So, it sets a flag saying "Hey, INT
    28, if you see this flag set, then do the TSR." So the
    INT 28 code, here, examines the flag. If the flag is set, INT 28
    knows that the TSR was activated, so it calls it now.
    We can do this because DOS calls INT 28 only if it's safe
    for something else to run.

    }
    begin
      { Call saved INT 28H handler. }
      asm
        PUSHF
        CALL PInt28
      end;
      if  MadeActive  then
      begin
        TSRInUse := True;
        MadeActive := False;
        RunPopUp;
        TSRInUse := False;
      end;
    end; {BackgroundInt}

    procedure KeyboardInt;
    interrupt;
    { INT 09H }
    { Examines all keyboard interrupts. First calls the
    existing interrupt handler. If our TSR is NOT currently
    running, then it checks for the magic pop keystrokes. If
    the TSR is already running, then we do not want to
    activate it again, so we ignore keystroke checking when
    the TSR is already alive and on-screen.

    Several bytes in low memory contain keyboard status
    information. By checking the values in these bytes,
    various "not normal" key combinations can be detected.
    As implemented here, the TSR is made active by pressing
    the left Alt key, plus the SysRq key (Print Screen on my
    PC). You can change these keystrokes to something else.
    }
    const
      CallTSRMask = 6;
      { ACTIVATE TSR = left Alt key + SysRq key }
    var
      ScanCode: byte absolute $40:$18;
        { One of the keyboard status bytes. }
    begin
      { Call existing keyboard interrupt handler. }
      asm
        PUSHF
        CALL PINT09
      end;

      if  not TSRInUse  then
        if        (ScanCode and CallTSRMask) = CallTSRMask  then
        begin
          { The TSR has been activated. }
          TSRInUse := True;
            { Set to TRUE to prevent reactivation of this TSR. }
          if  (PInDosFlag^ = 0)  then
          begin
            { If in "Safe" DOS area, then pop up now. }
            MadeActive := False; { So INT $28 won't call us. }
            RunPopUp;
            TSRInUse := False;
          end
          else
            MadeActive := True;
              { o/w, set flag let INT 28 call us when ok. }
        end;
    end; {KeyboardInt}

    procedure DoUnInstall ( var Removed: Boolean ); forward;

    { These are "local" to OurInt12; it is safer to store them in the
    TSR's global data area than to place them on the stack as
    local variables. }
    var
      IdStr : ^String8;
      MessageNum : Integer;

    procedure OurInt12
      (_AX, BX, CX, DX, SI, DI, DS, ES, BP:Word);
    interrupt;
    { INT 12H }
    { Intercepts INT 12H calls. If the ES:BX register
    just happens to point to IdStr1, then the command-line
    TSR program just called in. If this is the case, the
    other registers could be used to pass a message to the
    running TSR. Here, it's used by the running TSR to return
    a pointer to another string, confirming that the TSR is
    indeed running.
    }

    var
      DeInstallOk: Boolean;
    begin
      IdStr := Ptr( ES, BX );
        { Check to see if ES:BX points to the }
        { magic ID string }
      If  IdStr^ = IdStr1  then
        MessageNum := CX
      else
      begin
        MessageNum := 0;
          { No message rcvd; this is normal DOS call. }
        asm
           pushf
           call    PInt12
           mov     _AX, ax
             { AX returns the memory size value. }
        end;
      end;
      if  MessageNum > 0   then
      { Process a message directed to this TSR. }
      begin
        case  MessageNum  of
          1:  begin
              { Returns pointer to IdStr2 indicating this
              TSR is here. }
                ES := Seg(IdStr2);
                BX := Ofs(IdStr2);
              end;
          2:  begin { Performs request to uninstall the TSR. }
                DoUnInstall (DeInstallOk);
                if         DeInstallOk  then
                  CX := 0 { Report success. }
                else
                  CX := 1; { Report failure. }
              end;
        end;
      end;
    end; {OurInt12}

    procedure DoUnInstall ( var Removed: Boolean );
    begin
      { See if any TSRs have loaded in memory after us.
      If another TSR has loaded after us, then we really
      cannot safely terminate this TSR. Why? Because when they
      terminate, they may reset their interrupts to point back
      to this TSR. And if this TSR is no longer in memory,
      uh-oh... }

      Removed := True;
      GetIntVec( $28, TempPtr );
      if  TempPtr <> @BackgroundInt  then
        Removed := False;

      GetIntVec( $12, TempPtr );
      If  TempPtr <> @OurInt12  then
        Removed := False;

      GetIntVec( $09, TempPtr );
      if  TempPtr <> @KeyBoardInt  then
        Removed := False;

      if  Removed  then
      begin
        { Restore interrupts }
        SetIntVec( $28, PInt28 );
        SetIntVec( $12, PInt12 );
        SetIntVec( $09, PInt09 );

        { Free up memory allocated to this program using
        INT 21 Func=49H "Release memory". }
        CPURegisters.AH := $49;
        CPURegisters.ES := PrefixSeg;{ Current program's PSP }
        Intr( $21, CPURegisters );
      end;
    end; {DoUnInstall}

    procedure InstallTSR (var AlreadyInstalled: Boolean );
    { Installs all interrupt handlers for this TSR. }

    var
      PSPPtr : ^Word;
      IdStr : ^String8;
    begin

      { Check to see if the TSR is already running by
      executing INT 12 with ES:BX pointing to IdStr1. If,
      after calling INT 12, ES:BX points to IdStr2, then the
      TSR is running since it must have intercepted INT 12 and
      set ES:BX to those return values. }

      with        CPURegisters  do
      begin
        ES := Seg(IdStr1);
        BX := Ofs(IdStr1);
        CX := 1;
        Intr( $12, CPURegisters );
        IdStr := Ptr( ES, BX );
        if        IdStr^ = IdStr2  then
        begin
           AlreadyInstalled := True;
           Exit;
        end;
        { TSR hasn't been installed, so install our
        INT 12 driver. }
        asm
          cli
        end;
        GetIntVec( $12, PInt12 );
        SetIntVec( $12, @OurInt12 );
        asm
          sti
        end;
      end;
      AlreadyInstalled := False;
      MadeActive := False;
      DiskInUse := 0;

      { Check to see if TSR is already installed. }
      TSRInUse := False;

      { Deallocate DOS Environment block if not needed. }
      { Comment out this code if you need to access
        environment strings. }
      PSPPtr := Ptr( PrefixSeg, $2C );
      CPURegisters.AX := $4900;
      CPURegisters.ES := PSPPtr^;
      Intr( $21, CPURegisters);

      asm
        cli
      end;

      { Save and set INT 28H, background process interrupt. }
      GetIntVec( $28, PInt28 );
      SetIntVec( $28, @BackgroundInt );

      { Save and set INT 09H, the keyboard interrupt handler. }
      GetIntVec( $09, PInt09 );
      SetIntVec( $09, @KeyboardInt );
      asm
        sti
      end;

      { Initialize pointer to DOS's InDos flag. }
      { Uses INT 21H Function 34H to retrieve a pointer to the
      InDos flag. The result is returned in the ES:BX
      registers. }
      CPURegisters.AH := $34;
      Intr( $21, CPURegisters );
      PInDosFlag := Ptr( CPURegisters.ES, CPURegisters.BX );

      asm
        CLI
      end;
      { Save our SS:SP for later use. }
      OurSS := SSeg;
      OurSP := SPtr;
      asm
        STI
      end;
    end; {InstallTSR}

    var
      InstallError: Boolean;

    begin {program}
      InstallTSR( InstallError );
      if  InstallError  then
      begin
        { This means that the TSR is already running.
          In that case, see if the command line requests
          an uninstall. }
        if  (ParamStr(1) = '/u') or (ParamStr(1) = '/U')  then
          { Send an Uninstall message to the TSR }
          with  CPURegisters  do
          begin
            ES := Seg(IdStr1);
            BX := Ofs(IdStr1);
            CX := 2;
            Intr( $12, CPURegisters );
            if  CX = 0  then
              Writeln('TSR is now uninstalled.')
            else
              Writeln('Unable to uninstall.');
            Exit;
          end
        else
          Writeln('!!!TSR is already installed!!!');
      end
      else
      begin
        Writeln('TSR is now resident.');
        Keep( 0 );
         { Exit to DOS, leaving program memory-resident. }
      end;
    end. {program}

[Back to TSR SWAG index] [Back to Main SWAG index] [Original]