Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[18.97.9.170] |
|
Сообщ.
#1
,
|
|
|
- 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:$17] and Key)<>0); end; procedure NewInt09;interrupt; const Switch:boolean=false; begin if ((Port[$60] and $7F)=32) (* 'D' is pressed *) and GetKeyStatus(4) (* Ctrl is pressed *) then begin asm mov ax,$0B00 cmp Switch,true je @@ClearBorder mov Switch,true mov bx,14 jmp @@Int10 @@ClearBorder: mov Switch,false xor bx,bx @@Int10: int $10 end; while (Port[$60] and $7F)=32 do; end; asm pushf call OldInt09 end; end; procedure Install; begin GetIntVec($09,OldInt09); SetIntVec($88,@NewInt88); SetIntVec($09,@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:$2C]; (* 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($09,OldInt09); (* Restore interrupt vectors *) SetIntVec($88,OldInt88); asm mov Error,false mov ax,$4900 mov es,EnvSeg int 21h (* Unload environment *) jc @@Error mov ax,$4900 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($88,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) |