- RU.PASCAL (2:5021/4.22) --------------------------------------- RU.PASCAL -

 From : Alexey Pavluchenko                  2:463/416.256   22 Jun 03  12:31:28

 To   : Sanya Petrochenko                                   29 Jun 03  16:00:40

 Subj : Расскажите

-----------------------------------------------------------------------------

Hola, Sanya!

Sanya Petrochenko (21 Jun 2003 at 01:18) wrote to Eugeny Fedorenko:

 

 SP> Сложность в том, что pезиденты в Туpбо-Паскале не выгpужаются из

 SP> памяти, а пpимеp можно найти из хелпа по (Ctrl+F1) к пpоцедуpе

 SP> KEEP.

 

Можно и выгружать. Было бы желание :)

 

========== Cut ==========

(* simptsr.pas *)

 

(* Simple TSR example. When you run this program at first *)

(* time, it installs itself into memory and then changes  *)

(* border color each time when Ctrl+D is pressed. When    *)

(* launched next time, it uninstalls itself from memory.  *)

 

(* Copyleft (C) 1999 by Asp                               *)

 

program SimpTSR;

{$M 1024,0,0}

 

uses DOS;

var OldInt88,OldInt09:pointer;  (* Saved interrupt vectors *)

    TSRPSP:word;                (* Resident copy PSP       *)

    Installed:boolean;          (* Installed flag          *)

 

procedure NewInt88;external;    (* This one is written in  *)

{$L INT88.OBJ}                  (* outline assembler :)    *)

 

function  GetKeyStatus(Key:word):boolean;

begin

 GetKeyStatus:=((MemW[Seg0040:] and Key)<>0);

end;

 

procedure NewInt09;interrupt;

const Switch:boolean=false;

begin

 if ((Port[] and F)=32)    (* 'D' is pressed  *)

    and GetKeyStatus(4)         (* Ctrl is pressed *)

 then begin

  asm

   mov ax,{text}B00

   cmp Switch,true

   je @@ClearBorder

   mov Switch,true

   mov bx,14

   jmp @@Int10

  @@ClearBorder:

   mov Switch,false

   xor bx,bx

  @@Int10:

   int

  end;

  while (Port[] and F)=32 do;

 end;

 asm

  pushf

  call OldInt09

 end;

end;

 

procedure Install;

begin

 GetIntVec(,OldInt09);

 SetIntVec(,@NewInt88);

 SetIntVec(,@NewInt09);

 WriteLn('SIMPTSR installed. Press Ctrl+D to change border color.');

 SwapVectors;

 Keep(0);

end;

 

procedure Unload;

var EnvSeg:word;

    Error:boolean;

begin

 EnvSeg:=MemW[TSRPSP:C];      (* Resident copy environment *)

 if (Mem[TSRPSP-1:0]<>77) or (Mem[EnvSeg-1:0]<>77) then begin

  WriteLn('MCB corrupted - something is wrong!');

  Halt(255);    (* Neither of them should be the last MCB *)

 end;

 SetIntVec(,OldInt09);       (* Restore interrupt vectors *)

 SetIntVec(,OldInt88);

 asm

  mov Error,false

  mov ax,00

  mov es,EnvSeg

  int 21h               (* Unload environment *)

  jc @@Error

  mov ax,00

  mov es,TSRPSP

  int 21h               (* Unload code & data *)

  jnc @@Exit

 @@Error:

  mov Error,true

 @@Exit:

 end;

 if Error then begin

  WriteLn('Could not unload SIMPTSR: memory allocation error.');

  Halt(255);

 end;

 WriteLn('SIMPTSR unloaded.');

end;

 

begin

 WriteLn('SimpTSR - Pascal TSR program example');

 WriteLn('Copyleft (C) 1999 by Asp');

 GetIntVec(,OldInt88);

 Installed:=false;

 if OldInt88<>nil then asm

  int 88h

  cmp ax,$DEED

  jne @@NotInstalled

  mov Installed,true

  mov TSRPSP,bx

  mov word ptr OldInt88,dx

  mov word ptr OldInt88+2,cx

  mov word ptr OldInt09,di

  mov word ptr OldInt09+2,si

 @@NotInstalled:

 end;

 if not Installed then Install else Unload;

end.

========== Cut ==========

 

========== Cut ==========

; int88.asm

 

.286

.model tpascal

 

.data

 extrn OldInt88:dword

 extrn OldInt09:dword

 extrn PrefixSeg:word

 

.code

 public NewInt88

 

NewInt88       proc far

 push ds

 mov ax,@Data

 mov ds,ax

 mov ax,0DEEDh         ; Magic number

 mov bx,PrefixSeg               ; bx = original PSP

 mov dx,word ptr OldInt88       ; cx:dx = original int 88h vector

 mov cx,word ptr OldInt88+2

 mov di,word ptr OldInt09

 mov si,word ptr OldInt09+2   ; si:di = original int 9 vector

 pop ds

 iret

NewInt88   endp

 

end

========== Cut ==========

 

 

Sincerely yours,

                                 Alexey.

 

---

 * Origin: General Protection Violation at (2:463/416.256)