SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00029 TSR UTILITIES AND ROUTINES 1 05-28-9314:09ALL SWAG SUPPORT TEAM CLKTSR.PAS IMPORT 16 /ÅWN {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}π{$M 1024,0,0}πUses Dos,π clock; { My clock ISR Unit in next message. }πConstπ IRet : Word = $cf;π IDStr : String[13]='TeeCee''s Clock';πVarπ p : Pointer;πbeginπ GetIntVec($66,p); { Int 66h is reserved For user defined interrupts }π inc(LongInt(p),2);π if String(p^) = IDStr then beginπ Writeln('TeeCee''s clock is already installed - you must be blind!');π halt;π endπ else beginπ Writeln('TeeCee''s clock is now installed For demo purposes only');π SetIntVec($66,@IRet); { IRet is obviously not an interrupt! }π { What we are actually doing is storing a Pointer to the IDStr }π { in the vector table - much like the way the Video font addresses }π { are stored. }π SwapVectors;π Keep(0);π end;πend.ππ(See the next message For the Unit Clock. )ππNow that is definintely For demonstration purposes only! It will work but has πseveral serious shortcomings!ππFirstly, it hooks the user defined interrupt $66 to allow any subsequent πexecutions to determine if the Program is already installed. It does this πwithout making any checks as to whether or not something else already "owns" πthis vector. Not very smart!ππSecondly, it provides no means to uninstall itself. Mmmmm... :-(ππThirdly, Graphics mode will cause problems. Again - not terribly smart!ππFinally, TSRs are not For the faint-of-heart or beginner. They are an πextraordinarily complex and difficult part of Dos Programming and if you are πserious about getting into TSRs then get as many good books as you can find πthat authoritively discuss the subject. Buying a good commercial toolbox, such πas Turbo Power's "TSRs Made Easy" is another smart move, as studying how the πmasters do it is one of the best ways to learn.π 2 05-28-9314:09ALL TREVOR J. CARLSEN Display "ON SCREEN" ClockIMPORT 42 /Åσ≥ Unit Clock;π{π Author: Trevor J Carlsen π Purpose: Demonstrate a simple "on screen" clock.π π This demo Unit works by "hooking" the timer interrupt ($1c). Thisπ interrupt is called by the hardware interrupt ($08) approximately 18.2π times every second and normally consists of a simple return instructionπ unless some other application has already hooked it.π π Because the routine is called roughly 18 times every second it isπ important that any processing it contains is optimised as much asπ possible. Obviously the best way to do this is by assembly language butπ in this demo I have used almost pure Turbo Pascal and have set up aπ counter Variable and any processing is only done every 6 calls. This isπ more than sufficient and minimises processing. The routine is by noπ means perfect - there will be a minor irregularity For the final 10π seconds of each day and For about half a second each hour. Better thisπ than to waste valuable processing time in the interrupt by coding itπ out.π π Because Dos is not re-entrant it is also important that the routine makeπ no calls to any Procedure or Function that makes use of Dos For itsπ operation. Thus no Writeln, Write can be used. To display the time onπ screen an Array is addressed directly to screen memory. Any changes inπ this Array are thus reflected on the screen. The downside to this isπ that on older CGAs this would cause a "snow" effect and code would beπ needed to eliminate this. It also means that the TP Procedure GetTimeπ cannot be used. So the time is calculated from the value stored at theπ clock tick counter location.π π To display an on-screen clock all that is required is For a Programmerπ to include this Unit in the Uses declaration of the Program.}π πInterfaceππConstπ DisplayClock : Boolean = True;ππImplementationπ{ Everything is private to this Unit }ππUses Dos;ππConstπ line = 0; { Change as required For position of display on screen }π column = 72; { Top left corner is 0,0 }π ScreenPos = (line * 160) + (column * 2);π Colour = $1f; { White on Blue }π ZeroChar = Colour shl 8 + ord('0'); π Colon = Colour shl 8 + ord(':');πTypeπ timestr = Array[0..7] of Word;π timeptr = ^timestr;πVarπ time : timeptr;π OldInt1c : Pointer;π ExitSave : Pointer;ππ{$F+}π Procedure Int1cISR; interrupt;π { This will be called every clock tick by hardware interrupt $08 }π Constπ count : Integer = 0; { To keep track of our calls }π Varπ hr : Word Absolute $40:$6e;π ticks : Word Absolute $40:$6c; π { This location keeps the number of clock ticks since 00:00}π min,π sec : Byte;π seconds : Word;π beginπ Asm cli end;π if DisplayClock then beginπ inc(count);π if count = 6 then { ticks to update the display } beginπ count := 0; { equality check and assignment faster than mod 9 }π seconds := ticks * LongInt(10) div 182; { speed = no Reals }π min := (seconds div 60) mod 60;π sec := seconds mod 60;ππ { The following statements are what actually display the on-screen time}ππ time^[0] := ZeroChar + (hr div 10); { first Char of hours }π time^[1] := ZeroChar + (hr mod 10); { second Char of hours }π time^[2] := Colon;π time^[3] := ZeroChar + (min div 10); { first Char of minutes }π time^[4] := ZeroChar + (min mod 10); { second Char of minutes }π time^[5] := Colon;π time^[6] := ZeroChar + (sec div 10); { first Char of seconds }π time^[7] := ZeroChar + (sec mod 10); { second Char of seconds }π end; { if count = 6 }π end; { if DisplayClock }π Asm π stiπ pushf { push flags to set up For IRET }π call OldInt1c; { Call old ISR entry point }π end;π end; { Int1cISR }ππProcedure ClockExitProc;π { This Procedure is VERY important as you have hooked the timer interrupt }π { and therefore if this is omitted when the Unit is terminated your }π { system will crash in an unpredictable and possibly damaging way. }π beginπ ExitProc := ExitSave;π SetIntVec($1c,OldInt1c); { This "unhooks" the timer vector }π end;π{$F-}ππProcedure Initialise;π Varπ mode : Byte Absolute $40:$49;π beginπ if mode = 7 then { must be a mono adaptor }π time := ptr($b000,ScreenPos)π else { colour adaptor of some kind }π time := ptr($b800,ScreenPos); π GetIntVec($1c,OldInt1c); { Get old timer vector and save it }π ExitSave := ExitProc; { Save old Exit Procedure }π ExitProc := @ClockExitProc; { Setup a new Exit Procedure }π SetIntVec($1c,@Int1cISR); { Hook the timer vector to the new Procedure }π end; { Initialise } π πbegin π Initialise;πend.ππ 3 05-28-9314:09ALL BOB SWART Clock ISR unit IMPORT 29 /Å└╤ {I have made some changes in your Unit Check, in order to make ik a bit fasterπand use somewhat less code and data space (61 Bytes in all). Also, the displayπof progress on screen is now 'ticking' because I swap the colors from white onπblue to gray on blue (perhaps a nice idea, now you can see if the machineπReally crashed)...π}π{$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,R-,S+,V-,X-}π{$M 8192,0,655360}π{$DEFINE COLOR}πUnit MyCheck;π{π TeeCee Bob Swart Saved:π Code size: 514 Bytes 455 Bytes 59 Bytesπ Data size: 32 Bytes 30 Bytes 2 Bytesππ Here is the $1C ISR that I will add (unless you wish to do that).ππ Some changes were made, which resulted in less code and data size, aπ little more speed, and display of the progress Variable on screen isπ made 'ticking' each second by changing the colour from white on blueπ to gray on blue and back With each update.π}πInterfaceππVar progress: LongInt Absolute $0040:$00F0;ππImplementationπ{ Everything is private to this Unit }πUses Dos;ππConstπ Line = 0; { Change as required For position of display on screen }π Column = 72; { Top left corner is 0,0 }π ScreenPos = (line * 80 * 2) + (column * 2);π Colour: Byte = $1F; { White/Gray on Blue }ππTypeπ TimeStr = Array[0..15] of Char;π TimePtr = ^TimeStr;ππVarπ {$IFDEF COLOR}π Time: TimeStr Absolute $B800:ScreenPos; { Assume colour display adaptor }π {$ELSE}π Time: TimeStr Absolute $B000:ScreenPos; { Otherwise mono display adaptor }π {$endIF}π OldInt1C: Pointer;π ExitSave: Pointer;πππ{$F+}πProcedure Int1CISR; Interrupt;π{ This will be called every clock tick by hardware interrupt $08 }πConst DisplayTickCount = 20;π TickCount: LongInt = DisplayTickCount;π HexChars: Array[$0..$F] of Char = '0123456789ABCDEF';πVar HexA: Array[0..3] of Byte Absolute progress;πbeginπ Asmπ cliπ end;π inc(TickCount);π if TickCount > DisplayTickCount then { ticks to update the display }π beginπ TickCount := 0; { equality check and assignment faster than mod }π { The following statements actually display the on-screen time }π Colour := Colour xor $08; { Swap between white and gray on blue }π FillChar(Time[1],SizeOf(Time)-1,Colour);π Time[00] := HexChars[HexA[3] SHR 4];π Time[02] := HexChars[HexA[3] and $F];π Time[04] := HexChars[HexA[2] SHR 4];π Time[06] := HexChars[HexA[2] and $F];π Time[08] := HexChars[HexA[1] SHR 4];π Time[10] := HexChars[HexA[1] and $F];π Time[12] := HexChars[HexA[0] SHR 4];π Time[14] := HexChars[HexA[0] and $F]π end { if TickCount > DisplayTickCount };π Asmπ stiπ pushf { push flags to set up For IRET }π call OldInt1C { Call old ISR entry point }π endπend {Int1CISR};π{$F-}πππProcedure ClockExitProc; Far;π{ This Procedure is VERY important as you have hooked the timer interrupt }π{ and therefore if this is omitted when the Unit is terminated your }π{ system will crash in an unpredictable and possibly damaging way. }πbeginπ ExitProc := ExitSave;π SetIntVec($1C,OldInt1C); { This "unhooks" the timer vector }πend {ClockExitProc};πππbeginπ progress := 0;π ExitSave := ExitProc; { Save old Exit Procedure }π ExitProc := @ClockExitProc; { Setup a new Exit Procedure }π GetIntVec($1C,OldInt1C); { Get old timer vector and save it }π SetIntVec($1C,@Int1CISR); { Hook the timer vector to the new Procedure }πend.ππ 4 05-28-9314:09ALL SWAG SUPPORT TEAM Prevent Ctl/Alt/Del Keys IMPORT 8 /Å│å PROGRAM NoBoot ;π{$M 1024, 0, 0 } { TSR : reserve 1K stack no heap }π{$S-} { Needed in a TSR }ππUsesπ Crt, { Sound }π Dos,π KeyIntr ;ππVarπ OldInt09 : Pointer ;ππ{$F+}πProcedure NewInt09 ; Interrupt ;πBeginπ EnableInterrupts ; { Delete key }π If ControlPressed and AltPressed and (ReadScanCode = $53) thenπ Beginπ ResetKeyboard ; { Ignore key }π EOI ;ππ Sound( 880 ) ; { optional }π Delay( 100 ) ;π Sound( 440 ) ;π Delay( 100 ) ;π NoSound ;ππ Endπ Elseπ CallInterrupt( OldInt09 ) ;πEnd ;ππBEGINπ GetIntVec( $09, OldInt09 ) ;π SetIntVec( $09, Addr(NewInt09) ) ;π Keep( 0 ) ; { make this a TSR }πEND.π 5 05-28-9314:09ALL SWAG SUPPORT TEAM Screen Saver TSR IMPORT 16 /Å┐┤ { I'm sorry that my reply Sounded rude, it wasn't meant as such. Probablyπthe best way to make a screen saver TSR is to latch onto inT $8, which isπcalled once a second to update the clock, using GetIntVec and SetIntVec.πSince your other TSR code is probably a normal Procedure For whatever otherπinterrupts you are using, just put the screen blanker Procedure inside theπother Procedure, and hopefully when you use Keep Dos will retain both yourπnormal TSR code and the screen saver code.π}π{$M 4096,0,0}π{$N-,S-}πProgram TSRplusSaver;πUses Dos;ππProcedure MyTSR (Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : Word);πinTERRUPT;πConst Maximum = 120; {2 minutes}πVar Elapsed : Word;πVar Saving : Boolean;ππProcedure ResetSvr (Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : Word);πInterrupt;πbeginπ if Saving then beginπ Saving := False;π Port[984] := 41; {Enable 6845 video}π end;π Elapsed := 0;π end;ππProcedure MyScreenSaver (Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : Word);πInterrupt;πbeginπ Inc (Elapsed);π if Elapsed=Maximum thenπ Port[984] := 33; {Disable 6845 video}π Saving := True;π end;π end;ππbegin {MyTSR}π MemW[$b800:$0000] := 3585; {Happy face}π end;ππbeginπ SetIntVec( $09, @ResetSvr); {Reset screen saver on Keypress}π SetIntVec( $08, @MyScreenSaver); {Increment elapsed every second,π activate when ready}π SetIntVec( $1C, @MyTSR); {Set up your TSR code}π Keep(0);πend.ππ{ I'm pretty sure something like this will work, but I haven't tried itπmyself yet. of course you'll have to add CLI instructions at theπbeginning of each of the interrupt Procedure and a restore interrupts afterπit, so nothing can occur during them except NMI. You may have some troubleπthere, since on the PCjr the NMI includes keyboard input (pretty stupid,πhuh?)π} 6 05-28-9314:09ALL SWAG SUPPORT TEAM General Purpose TSR Unit IMPORT 300 /ż8 Unit TSRUnit; {Create TSR Programs With Turbo Pascal 5.0 & TSRUnit}ππ{$B-,F-,I+,R-,S+} {Set Compiler directives to normal values.}ππInterface {=======================================================}π{πThe author and any distributor of this software assume no responsi-πbility For damages resulting from this software or its use due toπerrors, omissions, inCompatibility With other software or withπhardware, or misuse; and specifically disclaim any implied warrantyπof fitness For any particular purpose or application.π}πUses Dos, Crt;πConstπ{*** Shift key combination codes. }π AltKey = 8; CtrlKey = 4; LeftKey = 2; RightKey = 1;ππ TSRVersion : Word = $0204; {Low Byte.High Byte = 2.04 }ππTypeπ String80 = String[80];π ChrWords = Record Case Integer ofπ 1: ( W: Word );π 2: ( C: Char; A: Byte );π end;π LineWords = Array[1..80] of ChrWords;π WordFuncs = Function : Word;ππVarπ TSRScrPtr : Pointer; {Pointer to saved screen image. }π TSRChrPtr : Pointer; {Pointer to first Character to insert. }π TSRMode : Byte; {Video mode --------- beFore TSR popped up.}π TSRWidth : Byte; {Number of screen columns-- " " " " .}π TSRPage : Byte; {Active video page number-- " " " " .}π TSRColumn : Byte; {Cursor column number ----- " " " " .}π TSRRow : Byte; {Cursor row number -------- " " " " .}π{π** Procedure For installing the TSR Program. }πProcedure TSRInstall( TSRName : String; {Name or title For TSR. }π TSRFunc : WordFuncs;{Ptr to Function to call}π ShiftComb: Byte; {Hot key--shift key comb}π KeyChr : Char ); {Hot Key--Character key.}π{π ShiftComb and KeyChr specify the default hot keys For the TSR.π ShiftComb may be created by adding or oring the Constants AltKey,π CtrlKey, LeftKey, and RightKey together. KeyChr may beπ Characters 0-9 and A-Z.ππ The default hot keys may be overridden when the TSR is installedπ by specifying optional parameters on the command line. Theπ parameter Format is:π [/A] [/C] [/R] [/L] [/"[K["]]]π The square brackets surround optional items--do not include them.π Any Characters between parameters are ignored. The order of theπ Characters does not matter; however, the shift keys specified areπ cummulative and the last Character key "K" specified is the used.π}π{π** Functions For checking status of Printer LPT1. }πFunction PrinterOkay: Boolean; {Returns True if Printer is okay.}πFunction PrinterStatus: Byte; {Returns status of Printer.π Definition of status Byte bits (1 & 2 are not used), if set then:π Bit: -- 7 --- ---- 6 ---- -- 5 --- -- 4 --- -- 3 -- --- 0 ---π not busy Acknowledge No paper Selected I/O Err. Timed-outπ}π{π** Routines For obtaining one row of screen Characters. }πFunction ScreenLineStr( Row: Byte ): String80; {Returns Char. str.}πProcedure ScreenLine( Row: Byte; Var Line: LineWords; {Returns }π Var Words: Byte ); {chr & color}ππImplementation {==================================================}πVarπ BuffSize, InitCMode : Word;π NpxFlag : Boolean;π Buffer : Array[0..8191] of Word;π NpxState : Array[0..93] of Byte;π RetrnVal, InitVideo : Byte;π TheirFunc : WordFuncs;ππConst {offsets to items contained in Procedure Asm. }π UnSafe = 0; Flg = 1; Key = 2; Shft = 3;π Stkofs = 4; StkSs = 6; DosSp = 8; DosSs = 10;π Prev = 12; Flg9 = 13; InsNumb = 14;π Dos21 = $10; Dos25 = Dos21+4; Dos26 = Dos25+4;π Bios9 = Dos26+4; Bios16 = Bios9+4; DosTab = Bios16+4;π Our21 = DosTab+99; Our25 = Our21+51; Our26 = Our25+27;π Our09 = Our26+27; Our16 = Our09+127+8; InsChr = Our16+180-8;π PopUp = InsChr+4;ππProcedure Asm1; {Inline code--data storage and intercept routines. }πINTERRUPT;πbeginπInline(π{*** Storage For interrupt vectors. }π {Dos21: } >0/>0/ {Dos func. intr vector. }π {Dos25: } >0/>0/ {Dos abs. disk read intr. vector. }π {Dos26: } >0/>0/ {Dos abs. sector Write intr.vector. }π {Bios9: } >0/>0/ {BIOS key stroke intr. vector. }π {Bios16: } >0/>0/ {BIOS buffered keybd. input intr.vect.}ππ {DosTab: Array[0..98] of Byte = {Non-reetrant Dos Functions.}π 0/0/0/0/0/0/0/0/ 0/0/0/0/0/1/1/1/ 1/1/1/1/1/1/1/1/π 1/1/1/1/1/1/1/1/ 1/1/1/1/1/1/0/1/ 1/1/1/1/1/1/1/0/π 1/0/0/0/0/0/1/1/ 1/1/1/1/1/1/1/1/ 1/1/1/1/1/1/1/1/π 0/0/0/0/0/0/1/1/ 0/0/0/0/1/0/1/1/ 0/1/1/1/1/0/0/0/ 0/0/0/ππ{*** OurIntr21 ******* Intercept routine For Dos Function Intr.***}π{ 0} $9C/ { PUSHF ;Save flags. }π{ 1} $FB/ { STI ;Enable interrupts. }π{ 2} $80/$FC/$63/ { CMP AH,63H ;Assume unsafe if new }π{ 5} $73/<22-7/ { JNB IncF ;Function--skip table.}π{ 7} $50/ { PUSH AX ;Save Registers. }π{ 8} $53/ { PUSH BX ;Load offset to table.}π{ 9} $BB/>DosTab/ { MOV BX,[DosTab] }π{ 12} $8A/$C4/ { MOV AL,AH ;Load table entry }π{ 14} $2E/ { CS: ;index. }π{ 15} $D7/ { XLAT ;Get value from table.}π{ 16} $3C/$00/ { CMP AL,0 ;if True then set flag}π{ 18} $5B/ { POP BX ;Restore Registers. }π{ 19} $58/ { POP AX ; }π{ 20} $74/$17/ { JZ JmpDos21 ;Jump to orig. intr. }π{ 22} $2E/ {IncF: CS: ; }π{ 23} $FE/$06/>UnSafe/ { inC [UnSafe] ;Set UnSafe flag. }π{ 27} $9D/ { POPF ;Restore flags. }π{ 28} $9C/ { PUSHF ; }π{ 29} $2E/ { CS: ; }π{ 30} $FF/$1E/>Dos21/ { CALL Far [Dos21] ;Call orig. intr. }π{ 34} $FB/ { STI ;Enable interrupts. }π{ 35} $9C/ { PUSHF ;Save flags. }π{ 36} $2E/ { CS: ; }π{ 37} $FE/$0E/>UnSafe/ { DEC [UnSafe] ;Clear UnSafe flag. }π{ 41} $9D/ { POPF ;Restore flags. }π{ 42} $CA/$02/$00/ { RETF 2 ;Return & remove flag.}ππ{ 45} $9D/ {JmpDos21: POPF ;Restore flags. }π{ 46} $2E/ { CS: ; }π{ 47} $FF/$2E/>Dos21/ { JMP Far [Dos21] ;Jump to orig. intr. }π{ 51}π{*** OurIntr25 ********** Intercept routine For Dos Abs. Read *** }π{ 0} $9C/ { PUSHF ;Save flags. }π{ 1} $2E/ { CS: ; }π{ 2} $FE/$06/>UnSafe/ { inC [UnSafe] ;Set UnSafe flag. }π{ 6} $9D/ { POPF ;Restore flags. }π{ 7} $9C/ { PUSHF ; }π{ 8} $2E/ { CS: ; }π{ 9} $FF/$1E/>Dos25/ { CALL Far [Dos25] ;Call Dos abs. read. }π{ 13} $68/>Our25+19/ { PUSH Our25+19 ;Clean up stack with- }π{ 16} $C2/$02/$00/ { RET 2 ;out changing flags. }π{ 19} $9C/ { PUSHF ;Save flags. }π{ 20} $2E/ { CS: ; }π{ 21} $FE/$0E/>UnSafe/ { DEC [UnSafe] ;Clear UnSafe flag. }π{ 25} $9D/ { POPF ;Restore flags. Leave}π{ 26} $CB/ { RETF ;old flags on the stk.}π{ 27}π{*** OurIntr26 ********** Intercept routine For Dos Abs. Write ***}π{ 0} $9C/ { PUSHF ;Save flags. }π{ 1} $2E/ { CS: ; }π{ 2} $FE/$06/>UnSafe/ { inC [UnSafe] ;Set UnSafe flag. }π{ 6} $9D/ { POPF ;Restore flags. }π{ 7} $9C/ { PUSHF ; }π{ 8} $2E/ { CS: ; }π{ 9} $FF/$1E/>Dos26/ { CALL Far [Dos26] ;Call Dos abs. Write. }π{ 13} $68/>Our26+19/ { PUSH Our26+19 ;Clean up stack with- }π{ 16} $C2/$02/$00/ { RET 2 ;out changing flags. }π{ 19} $9C/ { PUSHF ;Save flags. }π{ 20} $2E/ { CS: ; }π{ 21} $FE/$0E/>UnSafe/ { DEC [UnSafe] ;Clear UnSafe flag. }π{ 25} $9D/ { POPF ;Restore flags. Leave}π{ 26} $CB/ { RETF ;old flags on the stk.}π{ 27}ππ{*** OurIntr9 ********** Intercept For BIOS Hardware Keyboard Intr}π{ 0} $9C/ { PUSHF ;Entry point. }π{ 1} $FB/ { STI ;Enable interrupts. }π{ 2} $1E/ { PUSH DS ; }π{ 3} $0E/ { PUSH CS ;DS := CS; }π{ 4} $1F/ { POP DS ; }π{ 5} $50/ { PUSH AX ;Preserve AX on stack.}π{ 6} $31/$C0/ { xor AX,AX ;Set AH to 0. }π{ 8} $E4/$60/ { in AL,60h ;Read Byte from keybd }π{ 10} $3C/$E0/ { CMP AL,0E0h ;if multi-Byte codes, }π{ 12} $74/<75-14/ { JE Sfx ;then jump and set }π{ 14} $3C/$F0/ { CMP AL,0F0h ;multi-Byte flag, Flg9}π{ 16} $74/<75-18/ { JE Sfx ; }π{ 18} $80/$3E/>Flg9/$00/ { CMP [Flg9],0 ;Exit if part of }π{ 23} $75/<77-25/ { JNZ Cfx ;multi-Byte code. }π{ 25} $3A/$06/>Key/ { CMP AL,[Key] ;Exit if key pressed }π{ 29} $75/<88-31/ { JNE PreExit ;is not hot key. }ππ{ 31} $50/ { PUSH AX ;Hot key was pressed, }π{ 32} $06/ { PUSH ES ;check shift key }π{ 33} $B8/$40/$00/ { MOV AX,0040h ;status Byte. First }π{ 36} $8E/$C0/ { MOV ES,AX ;load BIOS segment. }π{ 38} $26/ { ES: ; }π{ 39} $A0/>$0017/ { MOV AL,[0017h] ;AL:= Shift key status}π{ 42} $07/ { POP ES ;Restore ES register. }π{ 43} $24/$0F/ { and AL,0Fh ;Clear unwanted bits. }π{ 45} $3A/$06/>Shft/ { CMP AL,[Shft] ;Exit if not hot key }π{ 49} $58/ { POP AX ;shift key combination}π{ 50} $75/<88-52/ { JNE PreExit ;(Restore AX first). }ππ { ;Hot Keys encountered.}π{ 52} $3A/$06/>Prev/ { CMP AL,[Prev] ;Discard Repeated hot }π{ 56} $74/<107-58/ { JE Discard ;key codes. }π{ 58} $A2/>Prev/ { MOV [Prev],AL ;Update Prev. }π{ 61} $F6/$06/>Flg/3/ { TEST [Flg],3 ;if Flg set, keep key }π{ 66} $75/<99-68/ { JNZ JmpBios9 ;& Exit to orig. BIOS }π{ 68} $80/$0E/>Flg/1/ { or [Flg],1 ;9. else set flag and}π{ 73} $EB/<107-75/ { JMP SHorT Discard;discard key stroke. }ππ{ 75} $B4/$01/ {Sfx: MOV AH,1 ;Load AH With set flag}π{ 77} $88/$26/>Flg9/ {Cfx: MOV [Flg9],AH ;Save multi-Byte flag.}π{ 81} $C6/$06/>Prev/$FF/ { MOV [Prev],0FFh ;Change prev key Byte.}π{ 86} $EB/<99-88/ { JMP SHorT JmpBios9 }ππ{ 88} $3C/$FF/ {PreExit: CMP AL,0FFh ;Update previous key }π{ 90} $74/<99-92/ { JE JmpBios9 ;unless key is buffer-}π{ 92} $3C/$00/ { CMP AL,0 ;full code--a 00h }π{ 94} $74/<99-96/ { JZ JmpBios9 ;0FFh }π{ 96} $A2/>Prev/ { MOV [Prev],AL ;Update previous key. }ππ{ 99} $58/ {JmpBios9: POP AX ;Restore Registers and}π{100} $1F/ { POP DS ;flags. }π{101} $9D/ { POPF ; }π{102} $2E/ { CS: ; }π{103} $FF/$2E/>Bios9/ { JMP [Bios9] ;Exit to orig. intr 9.}ππ{107} $E4/$61/ {Discard: in AL,61h ;Clear key from buffer}π{109} $8A/$E0/ { MOV AH,AL ;by resetting keyboard}π{111} $0C/$80/ { or AL,80h ;port and sending EOI }π{113} $E6/$61/ { OUT 61h,AL ;to intr. handler }π{115} $86/$E0/ { XCHG AH,AL ;telling it that the }π{117} $E6/$61/ { OUT 61h,AL ;key has been }π{119} $B0/$20/ { MOV AL,20h ;processed. }π{121} $E6/$20/ { OUT 20h,AL ; }π{123} $58/ { POP AX ;Restore Registers and}π{124} $1F/ { POP DS ;flags. }π{125} $9D/ { POPF ; }π{126} $CF/ { IRET ;Return from interrupt}π{127}ππ{*** OurIntr16 ***** Intercept routine For Buffered Keyboard Input}π{ 0} $58/ {JmpBios16: POP AX ;Restore AX, DS, and }π{ 1} $1F/ { POP DS ;FLAGS Registers then }π{ 2} $9D/ { POPF ;exit to orig. BIOS }π{ 3} $2E/ { CS: ;intr. 16h routine. }π{ 4} $FF/$2E/>Bios16/ { JMP [Bios16] ; }ππ{ 8} $9C/ {OurIntr16: PUSHF ;Preserve FLAGS. }π{ 9} $FB/ { STI ;Enable interrupts. }π{ 10} $1E/ { PUSH DS ;Preserve DS and AX }π{ 11} $50/ { PUSH AX ;Registers. }π{ 12} $0E/ { PUSH CS ;DS := CS; }π{ 13} $1F/ { POP DS ; }π{ 14} $F6/$C4/$EF/ { TEST AH,EFh ;Jmp if not read Char.}π{ 17} $75/<48-19/ { JNZ C3 ;request. }ππ {*** Intercept loop For Read Key service.}π{ 19} $F6/$06/>Flg/1/ {C1: TEST [Flg],1 ;if pop up Flg bit is }π{ 24} $74/<29-26/ { JZ C2 ;set then call Inline }π{ 26} $E8/>122-29/ { CALL toPopUp ;pop up routine. }π{ 29} $F6/$06/>Flg/16/{C2: TEST [Flg],10h ;Jmp if insert flg set}π{ 34} $75/<48-36/ { JNZ C3 ; }π{ 36} $FE/$C4/ { inC AH ;Use orig. BIOS }π{ 38} $9C/ { PUSHF ;service to check For }π{ 39} $FA/ { CLI ;Character ready. }π{ 40} $FF/$1E/>Bios16/ { CALL Far [Bios16];Disable interrupts. }π{ 44} $58/ { POP AX ;Restore AX and save }π{ 45} $50/ { PUSH AX ;it again. }π{ 46} $74/<19-48/ { JZ C1 ;Loop Until chr. ready}ππ{ 48} $F6/$06/>Flg/17/{C3: TEST [Flg],11h ;Exit if neither bit }π{ 53} $74/<-55/ { JZ JmpBios16 ;of Flg is set. }π{ 55} $F6/$06/>Flg/$01/ { TEST [Flg],1 ;if pop up Flg bit is }π{ 60} $74/<65-62/ { JZ C4 ;set then call Inline }π{ 62} $E8/>122-65/ { CALL toPopUp ;pop up routine. }π{ 65} $F6/$06/>Flg/$10/{C4:TEST [Flg],10h ;Exit unless have }π{ 70} $74/<-72/ { JZ JmpBios16 ;Characters to insert.}π{ 72} $F6/$C4/$EE/ { TEST AH,0EEh ;if request is not a }π{ 75} $75/<-77/ { JNZ JmpBios16 ;chr. request, Exit. }ππ {*** Insert a Character. }π{ 77} $58/ { POP AX ;AX := BIOS service no}π{ 78} $53/ { PUSH BX ;Save BX and ES. }π{ 79} $06/ { PUSH ES ; }π{ 80} $C4/$1E/>InsChr/ { LES BX,[InsChr] ;PTR(ES,BX) := InsChr;}π{ 84} $26/ { ES: ;AL := InsChr^; }π{ 85} $8A/$07/ { MOV AL,[BX] ; }π{ 87} $07/ { POP ES ;Restore ES and BX. }π{ 88} $5B/ { POP BX ; }π{ 89} $F6/$C4/$01/ { TEST AH,01h ;if AH in [$01,$11] }π{ 92} $B4/$00/ { MOV AH,00h ; then ReportOnly; }π{ 94} $75/<114-96/ { JNZ ReportOnly ;Set Scan code to 0. }π{ 96} $FE/$06/>InsChr/ { inC [InsChr] ;Inc( InsChr ); }π{100} $FF/$0E/>InsNumb/ { DEC [InsNumb] ;Dec( InsNumb ); }π{104} $75/<111-106/ { JNZ SkipReset ;if InsNumb = 0 then }π{106} $80/$26/>Flg/$EF/ { and [Flg],0EFh ; Clear insert chr flg}π{111} $1F/ {SkipReset: POP DS ;Restore BX, DS, and }π{112} $9D/ { POPF ;FLAGS, then return }π{113} $CF/ { IRET ;from interrupt. }ππ{114} $1F/ {ReportOnly: POP DS ;Report Char. ready. }π{115} $9D/ { POPF ;Restore DS and FLAGS.}π{116} $50/ { PUSH AX ;Clear zero flag bit }π{117} $40/ { inC AX ;to indicate a }π{118} $58/ { POP AX ;Character ready. }π{119} $CA/>0002/ { RETF 2 ;Exit & discard FLAGS }ππ {*** Interface to PopUpCode Routine. }π{122} $50/ {toPopUp: PUSH AX ;Save AX. }π{123} $FA/ { CLI ;Disable interrupts. }π{124} $F6/$06/>UnSafe/$FF/{TEST [UnSafe],0FFh ;if UnSafe <> 0 }π{129} $75/<177-131/ { JNZ PP2 ; then Return. }π{131} $A0/>Flg/ { MOV AL,[Flg] ;Set in-use bit; clear}π{134} $24/$FE/ { and AL,0FEh ;pop up bit of Flg. }π{136} $0C/$02/ { or AL,2 ;Flg := (Flg and $FE) }π{138} $A2/>Flg/ { MOV [Flg],AL ; or 2; }π { ;**Switch to our stack}π{141} $A1/>Stkofs/ { MOV AX,[Stkofs] ;Load top of our stack}π{144} $87/$C4/ { XCHG AX,SP ;Exchange it With }π{146} $A3/>DosSp/ { MOV [DosSp],AX ;stk.ptr, save old SP.}π{149} $8C/$16/>DosSs/ { MOV [DosSs],SS ;Save old SS. }π{153} $8E/$16/>StkSs/ { MOV SS,[StkSs] ;Replace SS With our }π{157} $FB/ { STI ;SS. Enable interrupts}ππ{158} $9C/ { PUSHF ;Interrupt call to pop}π{159} $FF/$1E/>PopUp/ { CALL Far [PopUp] ;up TSR routine. }ππ{163} $FA/ { CLI ;Disable interrupts. }π{164} $8B/$26/>DosSp/ { MOV SP,[DosSp] ;Restore stack ptr }π{168} $8E/$16/>DosSs/ { MOV SS,[DosSs] ;SS:SP. Clear in-use }π{172} $80/$26/>Flg/$FD/ { and [Flg],0FDh ;bit of Flg. }ππ{177} $FB/ {PP2: STI ;Enable interrupts. }π{178} $58/ { POP AX ;Restore AX. }π{179} $C3 ); { RET ;Return. }π{180}πend; {Asm.} {end corresponds to 12 Bytes of code--used For storage}ππProcedure PopUpCode; {Interface between the BIOS intercept }πINTERRUPT; {routines and your TSR Function. }πConst BSeg = $0040; VBiosofs = $49;πTypeπ VideoRecs = Recordπ VideoMode : Byte;π NumbCol, ScreenSize, Memoryofs : Word;π CursorArea : Array[0..7] of Word;π CursorMode : Word;π CurrentPage : Byte;π VideoBoardAddr : Word;π CurrentMode, CurrentColor : Byte;π end;πVarπ Regs : Registers;π VideoRec : VideoRecs;π KeyLock : Byte;π ScrnSeg, NumbChr : Word;πbeginπ SwapVectors; {Set T.P. intr. vectors.}π Move( Ptr(BSeg,VBiosofs)^, VideoRec, {Get Video BIOS info. }π Sizeof(VideoRec) );π With VideoRec, Regs do beginπ if (VideoMode > 7) or {Abort pop up if unable}π (ScreenSize > BuffSize) then begin {to save screen image. }π SwapVectors; {Restore intr. vectors.}π Exit;π end;π KeyLock := Mem[BSeg:$0017]; {Save lock key states. }π if VideoMode = 7 then ScrnSeg := $B000 {Save screen--supports }π else ScrnSeg := $B800; {Text, MGA & CGA modes.}π Move( PTR( ScrnSeg, Memoryofs )^, Buffer, ScreenSize );π AX := InitVideo; {if in Graphics mode, }π if (VideoMode >=4) {switch to Text mode. }π and (VideoMode <= 6) then Intr( $10, Regs );π AX := $0500; {Select display page 0.}π Intr( $10, Regs );π CX := InitCMode; {Set cursor size. }π AH := 1;π Intr( $10, Regs );ππ TSRMode := VideoMode; {Fill global Variables }π TSRWidth := NumbCol; {with current inFormation}π TSRPage := CurrentPage;π TSRColumn := Succ( Lo( CursorArea[CurrentPage] ) );π TSRRow := Succ( Hi( CursorArea[CurrentPage] ) );ππ if NpxFlag then {Save co-processor state.}π Inline( $98/ $DD/$36/>NpxState ); {WAIT FSAVE [NpxState] }π{π*** Call user's Program and save return code--no. Char. to insert.π}π NumbChr := TheirFunc;π MemW[CSeg:InsNumb] := NumbChr;π if NumbChr > 0 then begin {Have Char. to insert.}π MemL[CSeg:InsChr] := LongInt( TSRChrPtr );π Mem[CSeg:Flg] := Mem[CSeg:Flg] or $10;π end;π{π*** Pop TSR back down--Restore Computer to previous state.π}π if NpxFlag then {Restore co-prcssr state.}π Inline( $98/ $DD/$36/>NpxState ); {WAIT FSAVE [NpxState] }ππ Mem[BSeg:$17] := {Restore key lock status.}π (Mem[BSeg:$17] and $0F) or (KeyLock and $F0);ππ if Mem[BSeg:VBiosofs] <> VideoMode then beginπ AX := VideoMode; {Restore video mode. }π Intr( $10, Regs );π end;π AH := 1; CX := CursorMode; {Restore cursor size. }π Intr( $10, Regs );π AH := 5; AL := CurrentPage; {Restore active page. }π Intr( $10, Regs );π AH := 2; BH := CurrentPage; {Restore cursor positon. }π DX := CursorArea[CurrentPage];π Intr( $10, Regs ); {Restore screen image. }π Move( Buffer, PTR( ScrnSeg, Memoryofs )^, ScreenSize );ππ SwapVectors; {Restore non-T.P. vectors.}π end;πend; {PopUp.}π{π***** Printer Functions:π}πFunction PrinterStatus: Byte; {Returns status of LPT1.}π{ Definition of status Byte bits (1 & 2 are not used), if set then:π Bit: -- 7 --- ---- 6 ---- -- 5 --- -- 4 --- -- 3 -- --- 0 ---π not busy Acknowledge No paper Selected I/O Err. Timed-outπ}πVar Regs : Registers;πbeginπ With Regs do beginπ AH := 2; DX := 0; {Load BIOS Function and Printer number. }π Intr( $17, Regs ); {Call BIOS Printer services. }π PrinterStatus := AH; {Return With Printer status Byte. }π end;πend; {PrinterStatus.}ππFunction PrinterOkay: Boolean; {Returns True if Printer is okay. }πVar S : Byte;πbeginπ S := PrinterStatus;π if ((S and $10) <> 0) and ((S and $29) = 0) thenπ PrinterOkay := Trueπ else PrinterOkay := False;πend; {PrinterOkay.}π{π***** Procedures to obtain contents of saved screen image.π}πProcedure ScreenLine( Row: Byte; Var Line: LineWords;π Var Words: Byte );πbeginπ Words := 40; {Determine screen line size.}π if TSRMode > 1 then Words := Words*2; {Get line's }π Move( Buffer[Pred(Row)*Words], Line, Words*2 ); {Characters and }πend; {ScreenLine.} {colors. }ππFunction ScreenLineStr( Row: Byte ): String80; {Returns just Chars}πVarπ Words, i : Byte;π LineWord : LineWords;π Line : String80;πbeginπ ScreenLine( Row, LineWord, Words ); {Get Chars & attributes. }π Line := ''; {Move Characters to String}π For i := 1 to Words do Insert( LineWord[i].C, Line, i );π ScreenLineStr := Line;πend; {ScreenString.}π{π***** TSR Installation Procedure.π}πProcedure TSRInstall( TSRName: String; TSRFunc: WordFuncs;π ShiftComb: Byte; KeyChr: Char );πConstπ ScanChr = '+1234567890++++QWERTYUIOP++++ASDFGHJKL+++++ZXCVBNM';π CombChr = 'RLCA"';πVarπ PlistPtr : ^String;π i, j, k : Word;π Regs : Registers;π Comb, ScanCode : Byte;πbeginπ if ofs( Asm1 ) <> 0 then Exit; {offset of Asm must be 0}π MemW[CSeg:StkSs] := SSeg; {Save Pointer to top of }π MemW[CSeg:Stkofs] := Sptr + 562; {TSR's stack. }π MemL[CSeg:PopUp] := LongInt(@PopUpCode); {Save PopUpCode addr. }π TheirFunc := TSRFunc; {& their TSR func. addr.}π Writeln('Installing Stay-Resident Program: ',TSRName );π{π***** Save intercepted interrupt vectors: $09, $16, $21, $25, $26.π}π GetIntVec( $09, Pointer( MemL[CSeg:Bios9] ) );π GetIntVec( $16, Pointer( MemL[CSeg:Bios16] ) );π GetIntVec( $21, Pointer( MemL[CSeg:Dos21] ) );π GetIntVec( $25, Pointer( MemL[CSeg:Dos25] ) );π GetIntVec( $26, Pointer( MemL[CSeg:Dos26] ) );π{π***** Get equipment list and video mode.π}π With Regs do beginπ Intr( $11, Regs ); {Check equipment list For }π NpxFlag := (AL and 2) = 2; {math co-processor. }π AH := 15; {Get current video mode }π Intr( $10, Regs ); {and save it For when TSR }π InitVideo := AL; {is activated. }π AH := 3; BH := 0; {Get current cursor size }π Intr( $10, Regs ); {and save it For when TSR }π InitCMode := CX; {is activated. }π end; {WITH Regs}π{π***** Get info. on buffer For saving screen image.π}π BuffSize := Sizeof( Buffer );π TSRScrPtr := @Buffer;π{π*** Determine activation key combination.π}π Comb := 0; i := 1; {Create ptr to }π PlistPtr := Ptr( PrefixSeg, $80 ); {parameter list. }π While i < Length( PlistPtr^ ) do begin {Check For parameters.}π if PlistPtr^[i] = '/' then begin {Process parameter. }π Inc( i );π j := Pos( UpCase( PlistPtr^[i] ), CombChr );π if (j > 0) and (j < 5) then Comb := Comb or (1 SHL Pred(j))π else if j <> 0 then begin {New activation Char. }π Inc( i ); k := Succ( i );π if i > Length(PlistPtr^) then KeyChr := #0π else beginπ if ((k <= Length(PlistPtr^)) and (PlistPtr^[k] = '"'))π or (PlistPtr^[i] <> '"') then KeyChr := PlistPtr^[i]π else KeyChr := #0;π end; {else begin}π end; {else if ... begin}π end; {if PlistPtr^[i] = '/'}π Inc( i );π end; {While ...}π if Comb = 0 then Comb := ShiftComb; {Use default combination. }π if Comb = 0 then Comb := AltKey; {No default, use [Alt] key.}π ScanCode := Pos( UpCase( KeyChr ), ScanChr ); {Convert Char. to}π if ScanCode < 2 then begin {scan code. }π ScanCode := 2; KeyChr := '1';π end;π Mem[CSeg:Shft] := Comb; {Store shift key combination}π Mem[CSeg:Key] := ScanCode; {and scan code. }π{π*** Output an installation message: Memory used & activation code.π}π {Writeln( 'Memory used is approximately ',π ( ($1000 + Seg(FreePtr^) - PrefixSeg)/64.0):7:1,' K (K=1024).');π }Writeln(π'Activate Program by pressing the following keys simultaneously:');π if (Comb and 1) <> 0 then Write(' [Right Shift]');π if (Comb and 2) <> 0 then Write(' [Left Shift]');π if (Comb and 4) <> 0 then Write(' [Ctrl]');π if (Comb and 8) <> 0 then Write(' [Alt]');π Writeln(' and "', KeyChr, '".');π{π*** Intercept orig. interrupt vectors; then Exit and stay-resident.π}π SetIntVec( $21, Ptr( CSeg, Our21 ) );π SetIntVec( $25, Ptr( CSeg, Our25 ) );π SetIntVec( $26, Ptr( CSeg, Our26 ) );π SetIntVec( $16, Ptr( CSeg, Our16 ) );π SetIntVec( $09, Ptr( CSeg, Our09 ) );π SwapVectors; {Save turbo intr.vectors.}π MemW[CSeg:UnSafe] := 0; {Allow TSR to pop up. }π Keep( 0 ); {Exit and stay-resident. }πend; {TSRInstall.}πend. {TSRUnit.}πππProgram TSRDemo; {An example TSR Program created using TSRUnit. }ππ{$M $0800,0,0} {Set stack and heap size For demo Program. }ππUses Crt, Dos, TSRUnit; {Specify the TSRUnit in the Uses statement.}π {Do not use the Printer Unit, instead treat}π {the Printer like a File; i.e. use the }π {Assign, ReWrite, and Close Procedures. }ππConst DemoPgmName : String[16] = 'TSR Demo Program';ππVarπ Lst : Text; {Define Variable name For the Printer. }π TextFile : Text; { " " " " a data File. }π InsStr : String; {Storage For Characters to be inserted into}π {keyboard input stream--must be a gobal or }π {heap Variable. }ππFunction IOError: Boolean; {Provides a message when an I/O error}πVar i : Word; {occurs. }πbeginπ i := Ioresult;π IOError := False;π if i <> 0 then beginπ Writeln('I/O Error No. ',i);π IOError := True;π end;πend; {OurIoresult.}π{π***** Demo routine to be called when TSRDemo is popped up.π be Compiled as a Far Function that returns a Word containingπ the number of Characters to insert into the keyboard inputπ stream.π}π{$F+} Function DemoTasks: Word; {$F-}πConstπ FileName : String[13] = ' :TSRDemo.Dat';π endPos = 40;π Wx1 = 15; Wy1 = 2; Wx2 = 65; Wy2 = 23;πVarπ Key, Drv : Char;π Done, IOErr : Boolean;π InputPos, RowNumb : Integer;π DosVer : Word;π InputString : String;ππ Procedure ClearLine; {Clears current line and resets line Pointer}π beginπ InputString := ''; InputPos := 1;π GotoXY( 1, WhereY ); ClrEol;π end;ππbeginπ DemoTasks := 0; {Default to 0 Characters to insert.}π Window( Wx1, Wy1, Wx2, Wy2 ); {Set up the screen display. }π TextColor( Black );π TextBackground( LightGray );π LowVideo;π ClrScr; {Display initial messages. }π Writeln;π Writeln(' Example Terminate & Stay-Resident (TSR) Program');π Writeln(' --written With Turbo Pascal 5.0 and Uses TSRUnit.');π Window( Wx1+1, Wy1+4, Wx2-1, Wy1+12);π TextColor( LightGray );π TextBackground( Black );π ClrScr; {Display Function key definitions. }π Writeln;π Writeln(' Function key definitions:');π Writeln(' [F1] Write message to TSRDEMO.DAT');π Writeln(' [F2] " " to Printer.');π Writeln(' [F3] Read from saved screen.');π Writeln(' [F8] Exit and insert Text.');π Writeln(' [F10] Exit TSR and keep it.');π Write( ' or simply echo your input.');ππ {Create active display Window. }π Window( Wx1+1, Wy1+14, Wx2-1, Wy2-1 );π ClrScr;π {Display system inFormation. }π Writeln('TSRUnit Version: ', Hi(TSRVersion):8, '.',π Lo(TSRVersion):2 );π Writeln('Video Mode, Page:', TSRMode:4, TSRPage:4 );π Writeln('Cursor Row, Col.:', TSRRow:4, TSRColumn:4 );ππ DosVer := DosVersion;π Writeln('Dos Version: ', Lo(DosVer):8, '.', Hi(DosVer):2 );ππ InputString := ''; {Initialize Variables. }π InputPos := 1;π Done := False;ππ Repeat {Loop For processing keystrokes. }π GotoXY( InputPos, WhereY ); {Move cursor to input position. }π Key := ReadKey; {Wait For a key to be pressed. }π if Key = #0 then begin {Check For a special key. }π Key := ReadKey; {if a special key, get auxiliary}π Case Key of {Byte to identify key pressed. }ππ{Cursor Keys and simple editor.}π{Home} #71: InputPos := 1;π{Right} #75: if InputPos > 1 then Dec( InputPos );π{Left} #77: if (InputPos < Length( InputString ))π or ((InputPos = Length( InputString ))π and (InputPos < endPos )) then Inc( InputPos );π{end} #79: beginπ InputPos := Succ( Length( InputString ) );π if InputPos > endPos then InputPos := endPos;π end;π{Del} #83: beginπ Delete( InputString, InputPos, 1 );π Write( Copy( InputString, InputPos, endPos ), ' ');π end;ππ{Function Keys--TSRDemo's special features.}π{F1} #59: begin {Write short message to a File. }π ClearLine;π Repeatπ Write('Enter disk drive: ',FileName[1] );π Drv := UpCase( ReadKey ); Writeln;π if Drv <> #13 then FileName[1] := Drv;π Writeln('Specifying an invalid drive will cause your');π Write('system to crash. Use drive ',π FileName[1], ': ? [y/N] ');π Key := UpCase( ReadKey ); Writeln( Key );π Until Key = 'Y';π Writeln('Writing to ',FileName );π {$I-} {Disable I/O checking.}π Assign( TextFile, 'TSRDemo.Dat' );π if not IOError then begin {Check For error. }π ReWrite( TextFile );π if not IOError then beginπ Writeln(TextFile,'File was written by TSRDemo.');π IOErr := IOError;π Close( TextFile );π IOErr := IOError;π end;π end;π {$I+} {Enable standard I/O checking.}π Writeln('Completed File operation.');π end; {F1}ππ{F2} #60: begin {Print a message, use TSRUnit's auxiliary }π {Function PrinterOkay to check Printer status. }π ClearLine;π Writeln('Check Printer status, then print if okay.');π if PrinterOkay then begin {Check if Printer is okay}π Assign( Lst, 'LPT1' ); {Define Printer device. }π ReWrite( Lst ); {Open Printer. }π Writeln( Lst, 'Printing perFormed from TSRDemo');π Close( Lst ); {Close Printer. }π endπ else Writeln('Printer is not ready.');π Writeln( 'Completed print operation.' );π end; {F2}ππ{F3} #61: begin {Display a line from the saved screen image--not}π {valid if the TSR was popped up While the }π {display was in a Graphics mode. }π ClearLine;π Case TSRMode of {Check video mode of saved image.}π 0..3,π 7: beginπ {$I-}π Repeatπ Writeln('Enter row number [1-25] from ');π Write('which to copy Characters: ');π Readln( RowNumb );π Until not IOError;π {$I+}π if RowNumb <= 0 then RowNumb := 1;π if RowNumb > 25 then RowNumb := 25;π Writeln( ScreenLineStr( RowNumb ) );π end;π else Writeln('not valid For Graphics modes.');π end; {Case TSRMode}π end; {F3}π{F8} #66: begin {Exit and insert String into keyboard buffer.}π ClearLine;π Writeln('Enter Characters to insert;');π Writeln('Up to 255 Character may be inserted.');π Writeln('Terminate input String by pressing [F8].');π InsStr := '';π Repeat {Insert Characters into a}π Key := ReadKey; {Until [F8] is pressed. }π if Key = #0 then begin {Check For special key.}π Key := ReadKey; {Check if key is [F8]. }π if Key = #66 then Done := True; {[F8] so done. }π endπ else begin {not special key, add it to the String.}π if Length(InsStr) < Pred(Sizeof(InsStr)) thenπ beginπ if Key = #13 then Writelnπ else Write( Key );π InsStr := InsStr + Key;π endπ else Done := True; {Exceeded Character limit. }π end;π Until Done;π DemoTasks := Length( InsStr ); {Return no. of chr. }π TSRChrPtr := @InsStr[1]; {Set ptr to 1st chr.}π end; {F8}ππ{F10} #68: Done := True; {Exit and Stay-Resident. }ππ end; {Case Key}π end {if Key = #0}π else begin {Key pressed was not a special key--just echo it. }π Case Key ofπ{BS} #08: begin {Backspace}π if InputPos > 1 then beginπ Dec( InputPos );π Delete( InputString, InputPos, 1 );π GotoXY( InputPos, WhereY );π Write( Copy( InputString, InputPos, endPos ), ' ');π end;π end; {BS}π{CR} #13: begin {Enter}π Writeln;π InputString := '';π InputPos := 1;π end; {CR}π{Esc} #27: ClearLine;π elseπ if Length( InputString ) >= endPos thenπ Delete( InputString, endPos, 1 );π Insert( Key, InputString, InputPos );π Write( Copy( InputString, InputPos, endPos ) );π if InputPos < endPos thenπ Inc( InputPos );π end; {Case...}π end; {else begin--Key <> #0}π Until Done;πend; {DemoTasks.}ππbeginπ TSRInstall( DemoPgmName, DemoTasks, AltKey, 'E' );πend. {TSRDemo.}πππ 7 05-28-9314:09ALL LARRY HADLEY Remove TSR IMPORT 30 /Å█« {ok i would like some info on how to remove a tsrππFollow these steps:ππ I tested out some TSR code today and came up With this. It's beenπ debugged and Functions as advertised. not as clean as I'd like,π but it works.π}ππ{**********************************************π * CLICK.PAS by Larry Hadley 2-02-1993 *π * donated to the public domain. if you use *π * this code or derive from it, credit would *π * be appreciated. *π ********************************************** }ππ{$S-,N-}π{$M 1024, 0, 0}πProgram CLICK;ππUsesπ Crt,Dos;ππVarπ SavedInt09h,π SavedInt66h :Pointer;ππProcedure keyClick;πbeginπ Sound(50);π Delay(1);π NoSound;πend;ππProcedure Int09h; interrupt;πbeginπ keyClick; { Sound click everytime called -π this is clumsy because key releases asπ well as keypresses are signalled. Goodπ thing this is For demo only! :-) }π Asmπ pushf { push flags to simulate "int" call }π call SavedInt09h { pass control to original int09 handler -π necessary to allow keyboard use. Alsoπ demo's chaining of interrupts. }π end;πend;ππProcedure Int66h(AX, BX, CX, DX, SI, DI, DS, ES, BP:Word); interrupt;πVarπ int09new :Pointer;πbeginπ if AX<>$FFFF thenπ Exit; { not our call, leave }ππ GetIntVec($09, int09new);π if int09new<>@int09h thenπ Exit; { interrupt vectors have been changed. }ππ SetIntVec($09, SavedInt09h); { restore interrupt vectors }π SetIntVec($66, SavedInt66h);ππ MemW[PrefixSeg:$16] := BX; { modify PSP to return to calling }π MemW[PrefixSeg:$0A] := DI; { Program... }π MemW[PrefixSeg:$0C] := ES;ππ Asmπ mov ah, $50π mov bx, PrefixSegπ push dsπ int $21 { set conText }π pop dsπ end;π AX := 0; { tell caller "no error" }πend;ππbegin { main - t.s.r. init code }π GetIntVec($09, SavedInt09h);π GetIntVec($66, SavedInt66h);ππ SetIntVec($09, #Int09h);π SetIntVec($66, @Int66h);ππ Writeln('Click TSR installed.');ππ Keep(0);πend.ππ{************************************************π * CLICKU.PAS by Larry Hadley 2-02-1993 *π * CLICK T.S.R. removal Program *π * released into the public domain. if you use *π * this code or derive from it, credit would be *π * appreciated. *π ************************************************}ππ{$S-,N-}πProgram CLICKU;ππUsesπ Dos;ππVarπ rtn_seg,π rtn_ofs : Word;π return : Pointer;ππLabel int66_error;ππProcedure Exit_Label; { ...to provide an address For Dos return to }πbeginπ Halt(0); { I haven't been able to establish For sure thatπ this code regains control here. BTW, Brian I haveπ code to save DS and restore upon return to thisπ Program if you're interested. This would allowπ using global Variables to save SS:SP. Int 21h funcπ $4C destroys DS (and just about everything else)π on Exit...}πend;ππbeginπ return := @exit_Label;π rtn_seg := SEG(return^);π rtn_ofs := ofS(return^);π Asmπ mov ax, $FFFFπ mov bx, PrefixSegπ mov es, rtn_segπ mov di, rtn_ofs { pass parms in Registers ax, bx, es, di}π int $66 { call i.s.r. uninstall Function }π cmp ax, 0π jne int66_error { i.s.r. has returned error }π end;π Writeln('Click TSR uninstalled.');π Asmπ mov ah, $4Cπ int $21 { Dos terminate }π end;ππ int66_error:π Writeln('Error removing TSR.');π Halt(1);πend.π 8 07-16-9306:03ALL STEVE MULLIGAN Write to DISK in a TSR IMPORT 50 /ÅQc ===========================================================================π BBS: Canada Remote SystemsπDate: 06-23-93 (10:24) Number: 27349πFrom: STEVE MULLIGAN Refer#: NONEπ To: EDWARD WALKER Recvd: NO πSubj: TSRS THAT WRITE TO DISK.. Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πTuesday June 22 1993 02:38, Edward Walker wrote to All:ππ EW> What do I need to set up in the code to write to disk in a TSR?ππHere's a TSR called BootRes. It opens a file and writes to disk every xπseconds :ππ=-=-=-=-=-=-=-=-= PART 1 =-=-=-=-=-=-=-=-=-=πprogram BootRes;ππ{$M 2048,0,0}π{$F+}ππUses BootVars, Crt, Dos;ππconstπ OLDSTACKSS : WORD = 0;π OLDSTACKSP : WORD = 0;π STACKSW : INTEGER = - 1;π OurStackSeg : word = 0;π OurStackSp : word = 0;π DosDelimSet : set of Char = ['\', ':', #0];ππvarπ R : registers;π DosSeg, DosBusy : word;π Tick, WaitBuf : integer;π NeedPop : boolean;ππPROCEDURE BEGINint;πINLINE($FF/$06/STACKSW/π $75/$10/π $8C/$16/OLDSTACKSS/π $89/$26/OLDSTACKSP/π $8E/$16/OURSTACKSEG/π $8B/$26/OURSTACKSP);ππPROCEDURE ENDint;πINLINE($FF/$0E/STACKSW/π $7D/$08/π $8E/$16/OLDSTACKSS/π $8B/$26/OLDSTACKSP);ππPROCEDURE CALLPOP(SUB:POINTER);πBEGINπINLINE($FF/$5E/$06);πEND;ππPROCEDURE CLI; INLINE($FA);πPROCEDURE STI; INLINE($FB);ππfunction Exist(fname : string) : boolean;πvarπ f1 : file; err : integer;πbeginπ {$I-}π assign(f1,fname); reset(f1); err := ioresult;π {$I+}π if err = 0 then close(f1); exist := err = 0;πend;ππ function AddBackSlash(DirName : string) : string;π {-Add a default backslash to a directory name}π beginπ if DirName[Length(DirName)] in DosDelimSet thenπ AddBackSlash := DirNameπ elseπ AddBackSlash := DirName+'\';π end;ππprocedure TsrCrap;πbeginπ CLI;π BEGINint;π STI;ππ NeedPop := False;ππ GetDate(h, m, s, hund);π TimeLoad.Year := h;π TimeLoad.Month := m;π TimeLoad.Day := s;π GetTime(h, m, s, hund);π TimeLoad.Hour := h;π TimeLoad.Min := m;π TimeLoad.Sec := s;ππ DoDate;π DoDate2;ππ if not exist(LogName) then beginπ assign(LogFile, LogName);π rewrite(LogFile);π write(LogFile, LogRec);π close(LogFile);π end;ππ assign(LogFile, LogName);π reset(LogFile);π if FileSize(LogFile) = 0 then beginπ close(LogFile);π assign(LogFile, LogName);π rewrite(LogFile);π write(LogFile, LogRec);π close(LogFile);π assign(LogFile, LogName);π reset(LogFile);π end;π seek(LogFile, FileSize(LogFile) - 1);π read(LogFile, LogRec);π DoDate2;π seek(LogFile, FileSize(LogFile) - 1);π write(LogFile, LogRec);π close(LogFile);π Tick := 0;ππ CLI;π ENDint;π STI;πend;π=-=-=-=-=-=-=-=-= PART 1 =-=-=-=-=-=-=-=-=-=ππ--- GoldED 2.41π * Origin: Ask me about SubMove * Carp, Ontario (1:163/307.30)π===========================================================================π BBS: Canada Remote SystemsπDate: 06-23-93 (10:25) Number: 27350πFrom: STEVE MULLIGAN Refer#: NONEπ To: EDWARD WALKER Recvd: NO πSubj: TSRS THAT WRITE TO DISK.. Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π=-=-=-=-=-=-=-=-= PART 2 =-=-=-=-=-=-=-=-=-=πprocedure RunTSR; Interrupt;πbeginπ CLI;π BEGINint;π STI;π inc(Tick);π if Tick > 18.2 * WaitBuf then beginπ NeedPop := True;π if MEM[DosSeg:DosBusy] = 0 then beginπ NeedPop := False;π PORT[$20] := $20;π TsrCrap;π end;π end;π CLI;π ENDint;π STI;πend;ππprocedure Int28TSR; Interrupt;πbeginπ CLI;π BEGINint;π STI;π if NeedPop = True then TsrCrap;π CLI;π ENDint;π STI;πend;ππprocedure InitTSR;πbeginπ OurStackSeg := SSEG;π InLine($89/$26/OurStackSp);π R.Ah := $34;π MSDOS(R);π DosSeg := R.ES;π DosBusy := R.BX;πend;ππprocedure ShowHelp;πbeginπ writeln('Usage : BOOTRES <command line options>');π writeln;π writeln('Valid Options : # Number of seconds to wait before writing currentπtime');π writeln(' /? This screen');πend;ππbeginπ InitTSR;ππ GetDir(0, LogName);π LogName := AddBackSlash(LogName) + 'BOOTLOG.DAT';π WaitBuf := 60;ππ writeln;ππ if ParamCount > 0 then beginπ if ParamStr(1) = '/?' then beginπ ShowHelp;π halt(0);π end;π val(ParamStr(1), WaitBuf, Tick);π if (Tick <> 0) or ((WaitBuf > 60 * 10) or (WaitBuf < 5)) then beginπ writeln('Must be an integer between 5 and ', 60 * 10);π halt(1);π end;π end else beginπ writeln('Type BOOTRES /? for help');π writeln;π end;ππ Tick := 0;ππ SetIntVec($28,@Int28TSR);π SetIntVec($1C,@RunTSR);ππ writeln('BootRes installed');ππ keep(0);πend. =-=-=-=-=-=-=-=-= PART 2 =-=-=-=-=-=-=-=-=-=ππ--- GoldED 2.41π * Origin: Ask me about VoteFix * Carp, Ontario (1:163/307.30)π===========================================================================π BBS: Canada Remote SystemsπDate: 06-23-93 (10:26) Number: 27351πFrom: STEVE MULLIGAN Refer#: NONEπ To: EDWARD WALKER Recvd: NO πSubj: TSRS THAT WRITE TO DISK.. Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π=-=-=-=-=-=-=-=-= PART 3 =-=-=-=-=-=-=-=-=-=πunit BootVars;ππinterfaceππuses Dos;ππconstπ Version = '1.00';π ProgName = 'BootLog';π CopYear = '1992 - 1993';ππtypeπ LogType = recordπ TimeLoad : DateTime;π TimeOff : DateTime;π end;ππvarπ LogFile : file of LogType;π LogRec : LogType;π h, m, s, hund : word;π TimeLoad, TimeOff : DateTime;π LogName : string;ππprocedure DoDate;πprocedure DoDate2;ππimplementationππprocedure DoDate;πbeginπ LogRec.TimeLoad.Year := TimeLoad.Year;π LogRec.TimeLoad.Month := TimeLoad.Month;π LogRec.TimeLoad.Day := TimeLoad.Day;π LogRec.TimeLoad.Hour := TimeLoad.Hour;π LogRec.TimeLoad.Min := TimeLoad.Min;π LogRec.TimeLoad.Sec := TimeLoad.Sec;πend;ππprocedure DoDate2;πbeginπ LogRec.TimeOff.Year := TimeLoad.Year;π LogRec.TimeOff.Month := TimeLoad.Month;π LogRec.TimeOff.Day := TimeLoad.Day;π LogRec.TimeOff.Hour := TimeLoad.Hour;π LogRec.TimeOff.Min := TimeLoad.Min;π LogRec.TimeOff.Sec := TimeLoad.Sec;πend;ππend.π=-=-=-=-=-=-=-=-= PART 3 =-=-=-=-=-=-=-=-=-=ππ--- GoldED 2.41π * Origin: Ask me about SubMove * Carp, Ontario (1:163/307.30)π 9 08-27-9321:31ALL SEAN PALMER Learning about TSR's IMPORT 15 /ÅÖ╡ {πSEAN PALMERππ>I don't know if he is or not...but I'd like to see a simple and verboseπ>explanation on how to make a TSR...pref. using the KEEP Procedure...ππOK. I'll Write up one right quick. This isn't gonna be tested (hard toπtest a TSR While keeping your mail Program in memory...)π}ππProgram TSRTest;ππUsesπ Dos;ππVarπ oldInt : Procedure; {hook For old keyboard interrupt handler}ππProcedure newInt; interrupt; { interrupt keyWord makes Procedure far }π { also saves/restores all regs and }π { ends With an iRet instruction }π { sets up DS correctly also but }π { Uses caller's stack }πVarπ i : Word;π b : Boolean;πbeginπ b := port[$60] < $80; {see if it's a press}ππ oldInt; {call old interrupt handler For keystrokes (BIOS)}ππ if b thenπ For i := 0 to $3FFF do {change screen colors as example}π mem[$B800 : i * 2] := succ(mem[$B800 : i * 2]) and $EF;πend;ππbeginπ getIntVec(9, @oldInt); { keep previous keyboard hooks }π setIntVec(9, @newInt); { patch in our keyboard interrupt handler }π keep(0); { returns Exit code of 0 (normal termination) }π { and stays resident }πend.ππ{π All it does is sit in memory, and every time you press a key,π it gets called, and it changes the screen colors.ππ That's about as simple as you're gonna get, now verbosity was never myπ strong point. if you don't understand something, ask.ππ DJ Murdoch's TPU2TPS For TP 6.0 lets you make VERY small tsr's, but thisπ will link in about 1k worth of the system Unit plus some stuff from theπ Dos Unit which will make it about 1.5k.ππ If you wanna Write TSR's the best bet is to learn assembly.π}π 10 08-27-9321:56ALL STEVE CONNET Screen Save TSR IMPORT 28 /ÅT {πSTEVE CONNETππ>Have you written a screen saver before (or has ANYONE ELSE on thisπ>echo)? Please post some code I could modify/study/adapt...ππI have written a screen saver TSR. Here's some source if you're interested.π}ππProgram Save20;π{ SAVE v2.0 by Steve Connet -- Sunday, Jan. 17, 1993π This is a simple TSR screen saver. Numeric keypad 5 is the hot key. }ππ{$M 1024,0,0} { reserve 1k of stack space }πUsesπ DOS; { needed to set int vectors }ππ{$F+}πVARπ KbdIntVec : Procedure; { used to get ISR }ππProcedure GoSave; Interrupt; { this is our baby }πBegin { gosave }π If Port[$60] = 76 then { Numeric Keypad 5 pressed? }π Begin { our baby }π Asmπ cli { ;clear interrupts }π mov ah, 0fh { ;get video mode, al=mode, bh=page }π int 10h { ;call interrupt }π mov ah, 03h { ;get cursor position, dl=x, dh=y }π int 10h { ;call interrupt }π push dx { ;store cursor position on stack }π push bx { ;store page number on stack }π push ax { ;store video mode on stack }π End;π Repeatπ Port[$3c2] := 0; { wierd video mode }π Port[$3c2] := 9; { wierd video mode }π Port[$3c2] := 247 { wierd video mode }π Until Port[$60] in [0..75, 77..128]; { wait for keypress }ππ Port[$60] := 1; { stuff left shift key }π { to disable right ctrl,alt,shift keys }π { so they don't mess up keyboard input }π Asmπ pop ax { ;restore video mode from stack }π or al,80h { ;set bit 7, prevent screen clearing }π mov ah,00h { ;set video mode }π int 10h { ;call interrupt }π pop bx { ;restore page number from stack }π mov ah,05h { ;set display page }π mov al,bh { ;use saved page number }π int 10h { ;call interrupt }π pop dx { ;restore cursor position from stack }π mov ah,02h { ;set cursor position }π int 10h { ;call interrupt }π sti { ;restore interrupts }π End;π End; { our baby }π Inline($9c); { PUSHF push flags }π KbdIntVec; { call old ISR using saved vector }πEnd;π{$F-}ππBeginπ Writeln(#13#10, 'SAVE 2.0 by Steve Connet', #13#10, 'Installed.');π GetIntVec($9, @KbdIntVec); { define a procedure for ISR }π SetIntVec($9, @GoSave); { insert ISR into keyboard chain }π Keep(0) { terminate and stay resident }πEnd.ππ{π The GoSave procedure has two statements that you may want to take outπ at the very beginning and at the end. CLI and STI are assemblyπ statements that prevent interrupts from happening during our procedure.π The downfall of these statements is that it prevents the internal clockπ from being updated while the procedure is executing.π} 11 08-27-9322:07ALL CHRIS PRIEDE Sample TSR Routine IMPORT 19 /Å[. {πCHRIS PRIEDEππ> Can anyone give me any samples of TSR routines?ππ My old example of a generic keyboard TSR has mysteriouslyπdisappeared, so I had to write a new one. This is as simple TSR as itπcan be: no stack switching, no DOS reentrancy check. In the formπpresented here it simply beeps when you press Shift-Esc. Set your ownπhotkey and rewrite TsrMain to turn it into something useful.ππ Use Crt unit for screen writes and don't try to access files. Sinceπit uses foreground program's stack, you shouldn't use deeply nested orπrecursive function calls, or declare large local variables. This is moreπon demo side, but will get you started.π}ππprogram GenericKeyboardTSR;π{$M 0, 0, 512} { reduce memory size }π{$S-,R-} { can't use stack or range checking in TSR }πππusesπ Dos, Crt;ππConstπ RtShift = $01;π LtShift = $02;π AnyShift = RtShift + LtShift;π Ctrl = $04;π Alt = $08;ππ HotKey = $01; { Hotkey scan code, Esc }π HotShiftState = AnyShift; { Hotkey shift state }π FakeFlags = 0; { Fake flags for interrupt call }ππtypeπ IntProc = procedure(Flags : word);ππvarπ OldInt09 : IntProc;π Popped : boolean;πππprocedure Enable; Inline($FB); { inline macro -- STI }ππprocedure TsrMain; { TSR main procedure, executed on hotkey }πbeginπ Sound(400); { Make noise (replace with something useful) }π Delay(100);π NoSound;πend;ππprocedure NewInt09; interrupt;πbeginπ Enable; { Allow other interrupts }π if (not Popped) and (Port[$60] = HotKey) and { if not in TSR already }π (Mem[$40 : $17] and $0F = HotShiftState) then { and hotkey detected }π beginπ Popped := true; { set Popped to avoid re-entry }π Port[$61] := Port[$61] or $80; { reset keyboard }π Port[$61] := Port[$61] and not $80;π Port[$20] := $20; { signal end of interrupt }π TsrMain; { run TSR main procedure }π Popped := false; { clear Popped and return }π endπ elseπ OldInt09(FakeFlags); { call old handler }πend;πππbegin { installation }π Popped := false;π GetIntVec($09, pointer(@OldInt09)); { Install int. handler}π SetIntVec($09, @NewInt09);π Keep(0); { stay resident }πend.π 12 11-02-9305:34ALL CEES BINKHORST TSR in DPMI Mode IMPORT 85 /Åä╟ {πCEES BINKHORSTππ> I have a Turbo Pascal program running in DPMI mode that needs toπ> interface to a real mode TSR program. The TSR program issuesπ> INT$61 when it has data that needs to be serviced. I've installedπ> an interupt service routine that works ok in real mode, but not DPMI.ππHave a look at the following. With some amendments it will do what you want.ππ;from c't 1/1992 #196π.286p ;generate protected mode code for 286 or higherππdpmitsr segment public ;dpmitsr: name of programπ ;segment: indicates start of programcode forπ ; 'dpmitsr'. see also end of code: 'dpmitsr ends'π ;public (without addition (name)): instructionπ ; for linker to put all of it in one segmentπ assume cs:dpmitsr, ds:dpmitsr ;as soon as program starts 'cs' andπ ; 'ds' cpu-registers (code and data segmentπ ; segment registers) are filled with memoryπ ; position of start of program 'dpmitsr'π ;there are no seperate code en dataπ ; segmentsπolduserint label word ;π dw ?, ?πreadmessage db 'This text is in TSR and is be shown through a pointer.', 0πwritemessage db 'This text is copied from TSR', 0πwritedata equ $-offset writemessage ;calculate length 'writemessage' andπ ; use value later in programπ;--------- procedure 'userint' is comparable with a pascal instruction if:π; case ah of 0: execute instruction 'message'π; 1: excute instruction 'read'π; 2: excute instruction 'write'πuserint proc far ;new int 61hπ ;userint: name has only measning within thsi text forπ ; compiler - see also end 'userint endp'π ;proc far: instruktion for compiler to generate codeπ ; to push a segment:offset return address on the stackπ ; (near proc pushes only offset)π ; this procedure is called from anotherπ ; code segment (dos through int. in dpmiwin!)π pushf ;save flagsπ cmp ah, 00h ;message instruction - see dpmiwin dcs.eax:=$00000000π je messageπ cmp ah, 01h ;read instruction = dpmiwin dcs.eax:=$00000100π je readπ cmp ah, 02h ;write instruction = dpmiwin dcs.eax:=$00000200π je writeπ popf ;put flags back if ah is not 00, 01 or 02 in ah andπ jmp dword ptr cs:[olduserint] ; continue with old interruptπ;---------- procedure 'message'πmessage: mov ax,0affeh ;affe hex is in-memory mark of this programπ popf ;put flags backπ iret ;interrupt ends here and has only putπ ; affe hex in cpu register axπ ;program dpmiwin will see it there and know thenπ ; that 'dpmitsr' is loaded in memoryπ;---------- procedure 'read'πread: mov ax, seg dpmitsr ;make registers es:di together pint toπ mov es, ax ; string readmessage. this will then be usedπ ; by 'dpmiwin' to put it on the screenπ mov di, offset readmessageπ popf ;put flags backπ iret ;interrupt ends now hereπ;---------- procedure 'write'πwrite: push cx ;save registersπ push siπ push dsπ cld ;direction flag = 0π mov cx, seg dpmitsrπ mov ds, cx ;make ds:si point to string writemessageπ mov cx, writedata ;get calculated length of string writemessageπ mov si, offset writemessageπ rep movsb ; and copy string from ds:si to es:di.π ; es:di are put in dpmicallstruc by dpmiwinπ pop ds ;put registers backπ pop siπ pop cxπ popf ;put flags backπ iret ;interrupt now ends hereπuserint endp ;end of code for procedure 'userint'π ; van gehele echte interrupt dusπ;---------- this code does not remain in memoryπinstall: mov ax, seg dpmitsr ;make ds:dx point to string hello$π mov ds, axπ mov dx, offset hello$ ;offset of message that it is installedπ ; as a memory-resident programπ mov ah, 09h ;send string hello$ to (dos) screenπ int 21h ; to signal installation of 'dpmitsr'π mov ax, 03561h ;what is old address of int. 61hπ int 21hπ mov [olduserint], bx ; and save it in two stepsπ mov [olduserint+2], es ;π mov ax, 2561h ;subfunction 25 of int. 21: pu new addressπ mov dx, offset userint; int. 61h (procedure 'userint') in memoryπ int 21hπ mov dx, offset install ;how many bytes (convert to paragraphs by:πshr 4)π shr dx, 4 ; of program have toπ add dx, 011h ; remain in memoryπ mov ax, 03100h ;subfunction 31 of int. 21 with 'returnπcode' 0π int 21h ;makes part of program residentπhello$ db 13,10,'DPMITSR-example installed.',13,10,'$'πdpmitsr endsπ end install ;end of installation procedureππ}πprogram dpmiwin; {from c't 1/1992 # 197}ππusesπ winprocs,π wintypes,π win31,π wincrt;ππtypeπ tDPMICallStruc = Record {for use by RMInterrupt}π EDI, ESI, EBP, Reserved,π EBX, EDX, ECX, EAX : longint;π Flags, ES, DS, FS,π GS, IP, CS, SP, SS : word;π end;ππfunction RMInterrupt(IntNo, flags, copywords : byte;π var DPMICallStruc : tDPMICallStruc) : boolean;πbeginπ asmπ push es {save es en di from protected mode on stack}π push diπ mov bh, flags {if bit 0 is zero interrupt controller ...}π {... and A20-line will be reset. other bits must be zero}π mov bl, intno {put interrupt nummer to be executed in register bl}π mov cx, word ptr copywords {cx = number of words that are to be copied...}π { from... prot. mode to real mode stack}π mov ax, 0300h {put DPMI simulate real mode interrupt nummer in register ax}π les di, dpmiCallStruc {16-bits pointer to record - 32 bits uses edi}π {les di, ...: load segment (2 bytes) dpmicallstruc in}π { register di en offset (ook 2 bytes) }π { in register es. in short load pointer to dpmicallstruc}π { in registers di:es }π int 31h {excute interrupt nummer in bl in real-mode after filling }π { cpu-registers with values from dpmicallstruc and return in}π { protected mode with contents of cpu-registers at end of real-mode}π { interrupt in dpmicallstruc. i.o.w. act as if dpmicallstruc }π { are the cpu-registers at the end of excuting the real-mode int.}π jc @errorπ mov ax, 1 {function succesfull}π jmp @doneπ @error:π xor ax, ax {make ax=0, function not succesfull}π @done:π pop di {put es and di back}π pop esπ end;πend;ππvarπ selector : word;π segment : word;π selseg : longint;π dcs : tdpmicallstruc;π printstrg : pchar;ππbeginπ fillchar(dcs, sizeof(dcs), 0); {zero dcs}π {------- verify presence of dpmitsr in memory}π dcs.eax := $00000000; {just for clarity that ax is called with function 0}π { as contents is already zero because of use}π { of function filchar() on previous line. }π rminterrupt($61, 0, 0, dcs);π if (dcs.eax and $ffff = $affe) thenπ writeln('DPMItsr in memory')π elseπ writeln('Something went wrong!');π {this part needs improvement. }π {if dpmitsr is not in memory then pc may crash,}π { which is not strange as then an interrupt }π { is called that most likely is 0000:0000 in }π { memory. }π {this is to be substituted with a routine that first checks}π { that pointer of int. 61 is not 0000:0000. }π {------- read string through pointer}π dcs.eax := $00000100; {call int. 61 (=dpmitsr) with ah = 1}π rminterrupt($61, 0, 0, dcs);π selector := allocselector(word(nil)); {make new selector and fill with values:}π setselectorbase(selector, longint(dcs.es) * 16);π { base: es is put in by 'dpmitsr'}π setselectorlimit(selector, longint($ffff));π { and limit: $ffff is maximum value. this}π { does not give problems because we put a}π { 'zero-terminated' string on the screen.}π printstrg := ptr(selector, word(dcs.edi)); {also di is put in by 'dpmitsr' }π writeln(printstrg);π freeselector(selector);π {------- read string by making a copy from real-mode memory toπ Windows-memory in low 640k-area}π selseg := globaldosalloc(100); {allocate 100 bytes Windows-memory below 640k.}π {high word of longint 'selseg' is segment for }π { use in real-mode and low word is selector }π { for use in protected mode. }π if selseg <> 0 thenπ beginπ selector := word(selseg and $ffff); {determine selector}π segment := word(selseg shr 16); {determine segment}π dcs.eax := $00000200; {call int. 61 (=dpmitsr) with ah = 2 }π dcs.es := segment; {use segment for int. 61 in real-mode}π dcs.edi := 0; {offset is 0 }π rminterrupt($61, 0, 0, dcs);π printstrg := ptr(selector, 0);π writeln(printstrg);π globaldosfree(selector);π end;πend.ππ{πTo excute the program, dpmitsr.exe has to be executed before starting Windows.πDpmitsr will remain permanently in memory.ππBoth DPMITSR.ASM and DPMIWIN.PAS were nicely running programs in early 1992πwith TPW. Now, under BPW an error is reported from the SYSTEM unit.πHowever, as I now don't have the time to trace the error herewith the programs,πas it will surely point the way for you to go.π}π 13 11-02-9306:32ALL LOU DUCHEZ Dealing with TSR's IMPORT 12 /Åç╜ (*πLOU DUCHEZππ>I need to write a TSR, but the books I have really don't go into much detailπ>about them. Anyone know any good books that explain about them?ππMy recommendation:ππ"Turbo Pascal 6.0: The Complete Reference" by Stephen O'BrienππTaught me about TSRs. The basic deal with a TSR is these things:ππ1) A $M directive to reduce the amount of memory used.π2) A "Keep" procedure to make it TSR.π3) (the tricky part) A new interrupt handler. Actually it's not so tricky.π What your handler should do is react to the hardware, then call the oldπ interrupt handler. In parts here:ππ A) Determine old handler address with getintvec. Assign it to aπ "procedure" variable like so:ππ var oldkbdhandler: procedure; { for a keyboard handler }ππ getintvec($09, @oldkbdhandler);πππ B) Create a new handler that reads the hardware: like so:ππ var port60h: byte; { global variable }πππ procedure newkeyboardhandler; interrupt;π beginπ port60h := port[$60]; { store keyboard port status }π asmπ pushf { PUSHF instruction is crucial before calling old ISR }π end;π oldkbdhandler; { run the old keyboard handler }π end;πππ C) To hook up the new handler, it's:ππ setintvec($09, @newkeyboardhandler);ππ*)π 14 11-02-9306:32ALL MARC BIR TSR template IMPORT 7 /Å┐═ {πMARC BIRππ>I'm looking For a template to build TSR Program.π}ππ{$M 2048, 0, 5120}πUsesπ Dos;ππVarπ OldKbdIntVec : Procedure;ππProcedure DoWhatever;πbeginπ if Mem[$B800:0] <> 32 Thenπ FillChar(Mem[$B800:0], 80 * 2, 32)π elseπ FillChar(Mem[$B800:0], 80 * 2, 23);πend;ππ{$F+}πProcedure NewKbdIntVec; Interrupt;πVarπ Input : Byte;πbeginπ Input := port[$60];π if Input = $3B then { F1 }π DoWhatever;π Inline ($9C);π OldKbdIntVec;πend;π{$F-}ππbeginπ GetIntVec($9,@OldKbdIntVec);π SetIntVec($9,@NewKbdIntVec);π Keep(0);πend.ππ{πThis works, but you will most likely want a better TSR initiater thanπKEEP, there are some PD/Shareware ones out. if you still need code,πNETMAIL me, the code I have For TSR's is a couple hundred lines...π}π 15 11-02-9306:32ALL LOU DUCHEZ More TSR Stuff IMPORT 18 /Åφ {πLOU DUCHEZππ>I recently wrote a short utility in TP. I want to make it a TSRπ>which can be activated by a hotkey (like ALT-R). Do I need toπ>redirect the Keyboard INT to my Program?ππRight on the nose.ππ>if so, then where does my Program direct the INT after that?ππTo the OLD keyboard interrupt. You can use the GetIntVec to findπwhere the interrupt originally pointed; and trust me, it's a royalπpain in the keister to Program your own. (Note: you'll want toπexecute a PUSHF instruction before calling the "old" interrupt;πeasily done With the built-in Assembler: Asm PUSHF end.)ππNow, For reading the Alt-R: you can get the "Alt" key fromπmemory location $0040:$0017. It Records the Alt key, shift keys,πcaps lock, etc. Each bit sets/reports whether the key is active orπinactive ("1" = "active"). Like so:ππConst insByte = $80; capsByte = $40; numByte = $20; scrollByte = $10;π altByte = $08; ctrlByte = $04; lshftByte = $02; rshftByte = $01;ππVar keyboardstat: Byte Absolute $0040:$0017;ππTo test if Alt is on, see if this expression evaluates to "True":ππ keyboardstat and altByte = altByteππAs For the "R", check port $60 (the keyboard port) For scan code $13.π(Maybe ya oughtta find a complete list of the scan codes.)ππ>Also, I want my Window to disappear when my Programπ>is finished (and the previous screen to come back).π>How can I do this?ππStore the old screen into memory. Hint: on Mono systems, it's theπ4000 Bytes starting at b000:0000; on color, it's the 4000 startingπat b800:0000. Use the "Move" Procedure first to move the 4000 Bytesπto an Array of 4000 Characters, then use "Move" to move the 4000 Bytesπback to the video location.ππ> (BTW, I could do all this on the Commodore 64 back in the good 'olπ>days when the 64 was king. Life was much simpler then).ππYeah, I can hear ya now: "Oh you spoiled kids. When I started inπcomputers, we had only 64k to work With, and we LIKED it! And weπdidn't waste our money on a separate 'monitor', oh no! we just hookedπour computers up to the TV. Damn kids these days."π}π 16 11-02-9317:03ALL ANDREW KEY Screen Saver TSR IMPORT 56 /Å╩╘ {πFrom: ANDREW KEYπSubj: Screen Saveπ}ππunit Scrnsavr;π{$F+}π(*************************************************************************)π(* Screen Saver *)π(* *)π(* Written by Jay A. Key -- Oct 1993 *)π(* Code may be modified and used freely. Please mention my name *)π(* somewhere in your docs or in the program itself. *)π(* *)π(* Self contained unit to install a text-mode screen saver in Turbo *)π(* Pascal programs. Simply include the following line in your code. *)π(* uses ScrnSavr; *)π(* *)π(* It will initialize itself automatically, and will remove itself *)π(* upon exit from your program, graceful exit or not. Functions *)π(* SetTimeOut and SetDelay are included if you wish to modify the *)π(* default values. *)π(* *)π(* Warning: will not properly save and restore screens while running *)π(* under the Turbo Pascal IDE. Runs great from DOS. *)π(*************************************************************************)ππinterfaceππuses Dos,Crt;ππfunction NumRows: byte; {Returns number of rows in current screen}πfunction ColorAdaptor: boolean; {TRUE if color video card installed}πprocedure SetTimeOut(T: integer); {Delay(seconds) before activation}πprocedure SetDelay(T: integer); {Interval between iterations}ππ(************************************)ππimplementationππtypeπ VideoArray = array[1..2000] of word; {buffer to save video screen}ππvarπ Timer: word;π Waiting: boolean;π OldInt15, {Keyboard interrupt}π OldInt1C, {Timer interrupt}π OldInt23, {Cntl-C/Cntl-Break handler}π ExitSave: pointer;π Position, Cursor: integer; {save and restore cursor positions}π VideoSave: VideoArray;π VideoMem: ^VideoArray;π TimeOut, Delay: integer;ππprocedure JumpToPriorIsr(p: pointer);π{Originally written by Brook Monroe, "An ISR Clock", pg. 64,π PC Techniques Aug/Sep 1992}π inline($5b/$58/$87/$5e/$0e/$87/$46/$10/$89/$ec/$5d/$07/$1f/π $5f/$5e/$5a/$59/$cb);ππfunction ColorAdaptor: boolean; assembler;π asmπ int 11 {BIOS call - get equipment list}π and al,$0010 {mask off all but bit 4}π xor al,$0010 {flip bit 4 - return val is in al}π end;ππfunction NumRows: byte; assembler; {returns number of displayable rows}π asmπ mov ax,$40π mov es,axπ mov ax,$84π mov di,axπ mov al,[es:di] {byte at [$40:$84] is number of rows in display}π end;ππprocedure HideCursor; assembler;π asmπ mov ah,$03π xor bh,bhπ int $10 {video interrupt}π mov Position,dx {save cursor position}π mov Cursor,cx {and type}π mov ah,$01π mov ch,$20π int $10 {video interrupt - hide cursor}π end;ππprocedure RestoreCursor; assembler;π asmπ mov ah,$02π xor bh,bhπ mov dx,Position {get old position}π int $10 {video interrupt - restore cursor position}π mov cx,Cursor {get old cursor type}π mov ah,$01π int $10 {video interrupt - restore cursor type}π end;ππprocedure RestoreScreen;π beginπ VideoMem^ := VideoSave; {Copy saved image back onto video memory}π RestoreCursor;π end;ππprocedure SaveScreen;π beginπ VideoSave := VideoMem^; {Copy video memory to array}π HideCursor;π end;ππprocedure DispMsg; {simple stub-out for displaying YOUR message(s),π pictures, etc...use your imagination!!!}π beginπ ClrScr;π GotoXY(random(50),random(23));π writeln('This would normally be something witty!');π end;ππprocedure NewInt15(Flags,CS,IP,AX,BX,CX,DX,π SI,DI,DS,ES,BP:WORD); interrupt; {keyboard handler}π beginπ Timer:=0; {Reset timer}π if Waiting then {Screen saver activated?}π beginπ RestoreScreen; {Restore saved screen image}π Waiting:= FALSE; {De-activate screen saver}π Flags:=(Flags and $FFFE); {Tell BIOS to ignore current keystroke}π endπ elseπ JumpToPriorISR(OldInt15); {call original int 15}π end;ππprocedure NewInt1C; interrupt; {timer interrupt}π beginπ Inc(Timer); {Increment timer}π if Timer>TimeOut then {No key hit for TimeOut seconds?}π beginπ Waiting := TRUE; {Activate screen saver}π SaveScreen; {Save image of video memory}π DispMsg; {Display your own message}π Timer := 0; {Reset timer}π end;π if waiting then {Is saver already active?}π beginπ if Timer>Delay then {Time for next message?}π beginπ Timer := 0; {Reset timer}π DispMsg; {Display next message}π end;π end;π JumpToPriorISR(OldInt1C); {Chain to old timer interrupt}π end;ππprocedure ResetIntVectors; {Restores Intrrupt vectors to orig. values}π beginπ SetIntVec($15,OldInt15);π SetIntVec($1C,OldInt1C);π SetIntVec($23,OldInt23);π end;ππprocedure NewInt23; interrupt; {Called to handle cntl-c/brk}π beginπ ResetIntVectors; {Restore old interrupt vectors}π JumpToPriorISR(OldInt23); {Chain to original int 23h}π end;ππprocedure MyExit; far; {exit code for unit}π beginπ ResetIntVectors; {Restore old interrupt vectors}π ExitProc:=ExitSave; {Restore old exit code}π end;ππprocedure SetVideoAddress; {Returns pointer to text video memory}π beginπ if ColorAdaptor thenπ VideoMem := ptr($B000,$0000)π elseπ VideoMem := ptr($B800,$0000);π end;ππprocedure SetTimeOut(T: integer); {Set delay(seconds) before activation}π beginπ TimeOut:=Round(T*18.2);π end;ππprocedure SetDelay(T: integer); {Set interval between iterations}π beginπ Delay:=Round(T*18.2);π end;ππ{Initialize unit}πbeginπ SetVideoAddress; {Set up address for video memory}π Waiting := FALSE; {Screen saver initially OFF}π Timer := 0; {Reset timer}π ExitSave := ExitProc; {Save old exit routine}π ExitProc := @MyExit; {Install own exit routine}π{Install user defined int vectors}π GetIntVec($15,OldInt15); {Keyboard handler}π SetIntVec($15,@NewInt15);π GetIntVec($1c,OldInt1C); {Timer int}π SetIntVec($1c,@NewInt1C);π GetIntVec($23,OldInt23); {Cntl-C/Brk handler}π SetIntVec($23,@NewInt23);π SetTimeOut(120);π SetDelay(15);πend.ππ 17 01-27-9411:55ALL WILBERT VAN LIEJEN TSR Clock IMPORT 31 /Å{┘ {π> I would like to include a clock in my current project which will beπ> updated once a minute. Instead of constantly checking the computer's clockπ> and waiting for it to change, I would like to use an interrupt.ππThis one has even a hot key handler. If you want to update it once perπminute, bump a counter within the interrupt 1Ch handler till it reaches theπvalue 60*18.2. Then refresh the screen.π}ππProgram Clock;ππ{$G+,R-,S-,M 1024, 0, 0 }ππusesπ Dos;ππConstπ x = 71; { x location on screen }π y = 1; { y location on screen }π Keyboard = 9; { Hardware keyboard interrupt }π TimerTick = $1C; { Gets called 18.2 / second }π VideoOffset = 160 * (y - 1) + 2 * x;{ Offset in display memory }π yellow = 14;π blue = 1;π attribute = blue * 16 + yellow; { Clock colours }π VideoBase : Word = $B800; { Segment of display memory }π ActiveFlag : ShortInt = -1; { 0: on, -1: off }ππVarπ OrgInt9, { Saved interrupt 9 vector }π OrgInt1Ch : Pointer; { Saved interrupt 1Ch vector }π VideoMode : Byte absolute $0000:$0449;ππ{ Display a string using Dos services (avoid WriteLn, save memory) }ππProcedure DisplayString(s : String); Assembler;ππASMπ PUSH DSπ XOR CX, CXπ LDS SI, sπ LODSBπ MOV CL, ALπ JCXZ @EmptyStringπ CLDπ @NextChar:π LODSBπ XCHG AX, DXπ MOV AH, 2π INT 21hπ LOOP @NextCharπ @EmptyString:π POP DSπend;ππ{ Returns True if a real time clock could be found }πFunction HasRTClock : Boolean; Assembler;ππASMπ XOR AL, ALπ MOV AH, 2π INT 1Ahπ JC @NoRTClockπ INC AXπ @NoRTCLock:πend;ππ{ Release Dos environment }πProcedure ReleaseEnvironment; Assembler;πASMπ MOV ES, [PrefixSeg]π MOV ES, ES:[002Ch]π MOV AH, 49hπ INT 21hπend;ππ{ INT 9 handler intercepting Alt-F11 }πProcedure ToggleClock; Interrupt; Assembler;πConstπ F11 = $57; { 'F11' make code }π BiosSeg = $40; { Segment of BIOS data area }π AltMask = $08; { Bitmask of Alt key }π KbdFlags = $17; { Byte showing keyboard status }ππASMπ STIπ IN AL, 60hππ { F11 pressed? }π CMP AL, F11π JNE @PassThruππ { Alt-key pressed? }π PUSH BiosSegπ POP ESπ MOV AL, ES:[KbdFlags]π AND AL, AltMaskπ CMP AL, AltMaskπ JNE @PassThruππ { Flip status flag, force EOI and leave routine }π NOT [ActiveFlag]π IN AL, 61hπ MOV AH, ALπ OR AL, 80hπ OUT 61h, ALπ MOV AL, AHπ OUT 61h, ALπ CLIπ MOV AL, 20hπ OUT 20h, ALπ STIπ JMP @Exitππ @PassThru:π CLIπ PUSHFπ CALL DWord Ptr [OrgInt9]π @Exit:πend; { ToggleClock }ππ{ Convert a packed BCD byte to ASCII character }πProcedure Digit; Assembler;πASMπ PUSH AXπ CALL @HiNibbleπ POP AXπ CALL @LoNibbleπ RETNππ @HiNibble:π SHR AL, 4π JMP @MakeAsciiπ @LoNibble:π AND AL, 0Fhπ @MakeAscii:π OR AL, '0'π STOSWπend;ππ{ INT 1Ch handler that displays a clock on the right hand side of the screen }πProcedure DisplayClock; Interrupt; Assembler;πASMπ CMP [ActiveFlag], 0π JNE @Exitπ CLDπ MOV AH, 2π INT 1Ahπ MOV ES, [VideoBase]π MOV DI, VideoOffsetπ MOV AH, attributeπ MOV AL, CHπ CALL Digitπ MOV AL, ':'π STOSWπ MOV AL, CLπ CALL Digitπ MOV AL, ':'π STOSWπ MOV AL, DHπ CALL Digitπ PUSHFπ CALL DWord Ptr [OrgInt1Ch]π @Exit:πend;ππBeginπ If VideoMode = 7 Thenπ VideoBase := $B000;π GetIntVec(TimerTick, OrgInt1Ch);π SetIntVec(TimerTick, @DisplayClock);π GetIntVec(Keyboard, OrgInt9);π SetIntVec(Keyboard, @ToggleClock);π SwapVectors;π ReleaseEnvironment;π DisplayString('CLOCK installed. <Alt-F11> toggles on/off');π Keep(0);πend.π 18 01-27-9411:59ALL DAVID BRAATEN TSR Disk Writes IMPORT 17 /Åπù {π>Does anybody know how to write to disk inside a TSR usingπ>turbo pascal? I know all about how to write a simple TSR,π>cannot call Dos functions from within a hardware interrupt.ππHere is parts of a tsr to write to disk when a hotkey is pressedπ(Leftshift,left alt,right alt)π}ππuses dos,crt;πconstπ hotkey : byte = 5;π writekey : byte = 10; {write to disk when this combo comes up }πvarπ dat : file of word; {keep file definition on globals}ππprocedure diskit;πvarπ x,y : word;πbeginπ if not cracking thenπ beginπ cracking := true; {disable checking for hotkey while writing}π assign(dat,'a:\dump.scr');π rewrite(Dat);π display;π for y := 0 to 24 doπ for x := 0 to 79 doπ write(dat,wind[X,y]);π close(dat);π current := 1; {Reset current to 0}π cracking := false;π end;πend;π{------------------------------------------------------------}πprocedure calloldint(sub:pointer);πbegin {calloldint}πinline($9C/$FF/$5E/$06); {Assembly to pop pointer off stack and call it}πend; {calloldint}π{-------------------------------------------------------------}ππprocedure tick(flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp:word); interrupt;πvar regs:registers;πbeginπcalloldint(oldvec);π regs.ah := $12;π intr($16, regs);π statflags := (regs.al and regs.ah) and hotkey;π regflags := (regs.al and regs.ah) and writekey;πif (statflags = hotkey) and (cnt =0) thenπ beginπ cnt := 1;π display;π cnt := 0;π endπelse if (regflags = writekey) and (cnt = 0) thenπ beginπ cnt := 1;π diskit; {write to disk if hotkey}π cnt := 0;π endπelse inline($FB);πend; {tick}π{-----------------------------------------------------}ππbegin {MAIN}πwriteln('Saving screens function activated');πcurrent := 1;πgetintvec($08,oldvec);πsetintvec($08,@tick);πgetintvec($09,oldkbdvec);πsetintvec($09,@keyboard);πcnt := 0;πCracking := false;πkeep(0);πend. {MAIN}ππ{πThis will work for writing to disk as long as no other disk activity is beingπperformed.π} 19 01-27-9412:21ALL JAY A. KEY Screen Saver IMPORT 54 /Å`Ω unit Scrnsavr;π{$F+}π(*************************************************************************)π(* Screen Saver *)π(* *)π(* Written by Jay A. Key -- Oct 1993 *)π(* Code may be modified and used freely. Please mention my name *)π(* somewhere in your docs or in the program itself. *)π(* *)π(* Self contained unit to install a text-mode screen saver in Turbo *)π(* Pascal programs. Simply include the following line in your code. *)π(* uses ScrnSavr; *)π(* *)π(* It will initialize itself automatically, and will remove itself *)π(* upon exit from your program, graceful exit or not. Functions *)π(* SetTimeOut and SetDelay are included if you wish to modify the *)π(* default values. *)π(* *)π(* Warning: will not properly save and restore screens while running *)π(* under the Turbo Pascal IDE. Runs great from DOS. *)π(*************************************************************************)ππinterfaceππusesπ Dos, Crt;ππfunction NumRows : byte; {Returns number of rows in current screen}πfunction ColorAdaptor : boolean; {TRUE if color video card installed}πprocedure SetTimeOut(T : integer); {Delay(seconds) before activation}πprocedure SetDelay(T : integer); {Interval between iterations}ππimplementationππtypeπ VideoArray = array [1..2000] of word; {buffer to save video screen}ππvarπ Timer : word;π Waiting : boolean;π OldInt15, {Keyboard interrupt}π OldInt1C, {Timer interrupt}π OldInt23, {Cntl-C/Cntl-Break handler}π ExitSave : pointer;π Position,π Cursor : integer; {save and restore cursor positions}π VideoSave : VideoArray;π VideoMem : ^VideoArray;π TimeOut,π Delay : integer;ππprocedure JumpToPriorIsr(p : pointer);π{Originally written by Brook Monroe, "An ISR Clock", pg. 64,π PC Techniques Aug/Sep 1992}πinline($5b/$58/$87/$5e/$0e/$87/$46/$10/$89/$ec/$5d/$07/$1f/π $5f/$5e/$5a/$59/$cb);ππfunction ColorAdaptor : boolean; assembler;πasmπ int 11 {BIOS call - get equipment list}π and al,$0010 {mask off all but bit 4}π xor al,$0010 {flip bit 4 - return val is in al}πend;ππfunction NumRows : byte; assembler; {returns number of displayable rows}πasmπ mov ax,$40π mov es,axπ mov ax,$84π mov di,axπ mov al,[es:di] {byte at [$40:$84] is number of rows in display}πend;ππprocedure HideCursor; assembler;πasmπ mov ah,$03π xor bh,bhπ int $10 {video interrupt}π mov Position,dx {save cursor position}π mov Cursor,cx {and type}π mov ah,$01π mov ch,$20π int $10 {video interrupt - hide cursor}πend;ππprocedure RestoreCursor; assembler;πasmπ mov ah,$02π xor bh,bhπ mov dx,Position {get old position}π int $10 {video interrupt - restore cursor position}π mov cx,Cursor {get old cursor type}π mov ah,$01π int $10 {video interrupt - restore cursor type}πend;ππprocedure RestoreScreen;πbeginπ VideoMem^ := VideoSave; {Copy saved image back onto video memory}π RestoreCursor;πend;ππprocedure SaveScreen;πbeginπ VideoSave := VideoMem^; {Copy video memory to array}π HideCursor;πend;ππprocedure DispMsg; {simple stub-out for displaying YOUR message(s),π pictures, etc...use your imagination!!!}πbeginπ ClrScr;π GotoXY(random(50), random(23));π writeln('This would normally be something witty!');πend;ππprocedure NewInt15(Flags,CS,IP,AX,BX,CX,DX,π SI,DI,DS,ES,BP:WORD); interrupt; {keyboard handler}πbeginπ Timer := 0; {Reset timer}π if Waiting then {Screen saver activated?}π beginπ RestoreScreen; {Restore saved screen image}π Waiting := FALSE; {De-activate screen saver}π Flags := (Flags and $FFFE); {Tell BIOS to ignore current keystroke}π endπ elseπ JumpToPriorISR(OldInt15); {call original int 15}πend;ππprocedure NewInt1C; interrupt; {timer interrupt}πbeginπ Inc(Timer); {Increment timer}π if Timer > TimeOut then {No key hit for TimeOut seconds?}π beginπ Waiting := TRUE; {Activate screen saver}π SaveScreen; {Save image of video memory}π DispMsg; {Display your own message}π Timer := 0; {Reset timer}π end;π if waiting then {Is saver already active?}π beginπ if Timer > Delay then {Time for next message?}π beginπ Timer := 0; {Reset timer}π DispMsg; {Display next message}π end;π end;π JumpToPriorISR(OldInt1C); {Chain to old timer interrupt}πend;ππprocedure ResetIntVectors; {Restores Intrrupt vectors to orig. values}πbeginπ SetIntVec($15, OldInt15);π SetIntVec($1C, OldInt1C);π SetIntVec($23, OldInt23);πend;ππprocedure NewInt23; interrupt;{Called to handle cntl-c/brk}πbeginπ ResetIntVectors; {Restore old interrupt vectors}π JumpToPriorISR(OldInt23); {Chain to original int 23h}πend;ππprocedure MyExit; far; {exit code for unit}πbeginπ ResetIntVectors; {Restore old interrupt vectors}π ExitProc := ExitSave; {Restore old exit code}πend;ππprocedure SetVideoAddress; {Returns pointer to text video memory}πbeginπ if ColorAdaptor thenπ VideoMem := ptr($B000, $0000)π elseπ VideoMem := ptr($B800, $0000);πend;ππprocedure SetTimeOut(T : integer); {Set delay(seconds) before activation}πbeginπ TimeOut := Round(T * 18.2);πend;ππprocedure SetDelay(T : integer); {Set interval between iterations}πbeginπ Delay := Round(T * 18.2);πend;ππ{Initialize unit}πbeginπ SetVideoAddress; {Set up address for video memory}π Waiting := FALSE; {Screen saver initially OFF}π Timer := 0; {Reset timer}π ExitSave := ExitProc; {Save old exit routine}π ExitProc := @MyExit; {Install own exit routine}π {Install user defined int vectors}π GetIntVec($15, OldInt15); {Keyboard handler}π SetIntVec($15, @NewInt15);π GetIntVec($1c, OldInt1C); {Timer int}π SetIntVec($1c, @NewInt1C);π GetIntVec($23, OldInt23); {Cntl-C/Brk handler}π SetIntVec($23, @NewInt23);π SetTimeOut(120);π SetDelay(15);πend.ππ 20 01-27-9412:23ALL AMIR FRENKEL Clock 2 IMPORT 21 /Åf╜ {π> H E L P!!! I need help with the timer Interrupt... I guess? Hereπ> is what I would like to do, I want to have the Time in the upper rightπ> hand corner updated by the second. I was told that I need to "hook inπ> to the timmer interrupt" but, how do I do that? Any help would beπ> appreciated. And if possible make it as non technical as possable.ππHere is just the program your looking for!π}πProgram Clock_demo;π{$M $400 ,0 ,0} { Stack Size $400 , No Heap }π{$F+}πUses Dos ,Crt;πVarπ Count:Byte; { Counts Seconds }π Time:Longint Absolute $40:$6C; { Bios Keeps Clock Time Here }π Old1Cint:Procedure; { Linkage To Old 1C Interrupt }πππ{ Every 18 Pulses Shows Time At The Left Corner Of Screen }πProcedure Get_Time;Interrupt;πVar X ,Y:Byte;π Hour ,Minute ,Sec:Word;πBeginπ Inc(Count);π If Count =18 Then { Every Second 18.2 Pulses }π Beginπ Count:=0;π X:=Wherex; { Save Cursor Place }π Y:=Wherey;π Hour:=Time Div 65520; { Calculate Hours. In Each Hour }π { 18.2 * 60 * 60 Pulses }π Minute:=Time Mod 65520 Div 1092; { Calculate Minutes. In Each }π { Minute 18.2 * 60 Pulses }π Sec:=Round((Time Mod 65520 Mod 1092) / 18.2) Mod 60; { Seconds }π Gotoxy(70 ,1); { Left Corner Of Screen }π { Write time }π If Hour<10 Thenπ Write(0,Hour,':')π Elseπ Write(Hour,':');π If Minute<10 Thenπ Write(0,Minute,':')π Elseπ Write(Minute,':');π If Sec<10 Thenπ Write(0,Sec)π Elseπ Write(Sec);π Gotoxy(X ,Y); { Restore Cursor Position }π End;π Inline($9C); { Pushf - Push Flags }π Old1Cint; { Link Old 1C Procedure }πEnd;ππBegin { Of Main Program }π Count:=0; { Clock Pulses Counter }π Getintvec($1C ,@Old1Cint); { Save Old 1C Interrupt Vector }π Setintvec($1C ,@Get_Time); { Insert Current Interurupt Procedure }π Keep(0); { Terminate And Stay Resident - Tsr }πEnd.ππ 21 01-27-9412:23ALL ROB PERELMAN TSR Skeleton IMPORT 13 /Åê< {π>Thanks for the procedure. I don't want to use WRITE OR WRITELN causeπ>they are slow and used a lot of mem. I copy one from the book but itπ>makes the file even bigger!!!ππWell, I hope mine worked decently...it just didn't mod the currentπcursor position.ππ>You help certainly clear up something about TSR programming. Likeπ>why I need to interrupt hooking....but I still don't know how toπ>detect hotkey and check to see if the program has been loaded.π>Anyway, I used a skeleton named TSR_TPU.PAS of an unkown author toπ>write my TSR and it ran fine though not very good.ππGood...I'm glad you understand this. I don't have TSR_TPU, but I doπhave some source that shows how to detect if a TSR is already loaded andπhow to unload a TSR. The hotkey part you can do your self. You canπput in this program like the one I have below which will tell you what valuesπto look for in Port[$60] for keypresses. Just run it, and hit your key combo.πFor example, if you wanted ALT-A, you'd run this, and hit ALT-A, and you'dπsee it would exit with 30 on the screen. So in your TSR, you say:πIf Port[$60]=30 then...πSee? If you want the uninstall/detect TSR program, please tell me...π}ππProgram HotKey;ππUsesπ Crt, Dos;ππVarπ Old : Procedure;ππ{$F+}πProcedure New; Interrupt;πBeginπ Writeln(Port[$60]);π InLine($9C);π Old;πEnd;π{$F-}ππBeginπ GetIntVec($9, @Old);π SetIntVec($9, @New);π Repeat Until Keypressed;πEnd.π 22 02-03-9407:07ALL MIKE CHAMBERS A Working TSR IMPORT 171 /Å:▀ {π---------------------------------------------------------------------------π MD> How do you write something so it is interup driven?ππ MD> Can anyone post some simple code to perhaps count a numberπ MD> up by one and display it to the screen while at the sameπ MD> time allowing another part of the program do what ever it'sπ MD> suppose to.?ππMarek:ππThe features to which you refer constitute writing a TSR program.πThese programs are executed and terminate, but stay resident inπsystem memory. Prior to termination they insert themselves intoπthe Interrupt Service Routine chain of a known interrupt vector.ππThis programming was simplified somewhat in turbo Pascal Releaseπ4 or 5 with the addition of the Keep, GetIntVec and SetIntVecπprocedures of the DOS unit. However, these procedures are onlyπa small fraction of the coding needed to write reliable TSR's.πThis fact explains the lack of simple code examples.ππTo write good TSR's you need to read about them and play withπsomeone else's code for a while. (I've coded pascal for 17 years,πbut my first TSR took about 3 days to debug). For a solidπPascal reference, try Tom Swan's 'Mastering Turbo Pascal'.πTo figure out what the interrupt functions are doing, I recommendπRalf Brown's & Jim Kyle's 'PC Interrupts'. The book is derivedπfrom their well-known interrupt list (INTERnn.ZIP) availableπon many programming oriented BBS systems. The index of the bookπis well worth the money. Finally, I recommend Ed Mitchell'sπ"Borland Pascal Developer's Guide". Ed's TSR code is thoroughπand documented with education in mind. Since I'm quotingπED's book here, please buy a copy if you find the code useful.ππGood luckππ-------------------------------------------------------------------------π TSR Code Exampleπ-------------------------------------------------------------------------π}ππ{ 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π { 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}π 23 02-05-9407:56ALL LOU DUCHEZ Disable ctrl-alt-del IMPORT 17 /ÅîM π{πHmm ... My initial attempt was to disable the Int 19h handler, which isπcalled when you hit ctrl-alt-del; but it didn't work. So here's a TSRπthat "cheats": if you hit "ctrl" and "alt" and then "del", it flagsπ"ctrl" and "alt" as "not down" and so your system never sees the rebootπcondition. }ππ{$M $0400, $0000, $0000}π{$F+}ππprogram noreboot;πuses dos;ππconst ctrlbyte = $04; { Memory location $0040:$0017 governs the statuses of }π altbyte = $08; { the Ctrl key, Alt, Shifts, etc. the "$04" bit }π { handles "Ctrl"; "$08" handles "Alt". }ππvar old09h: procedure; { original keyboard handler }π ctrldown, altdown, deldown: boolean;π keyboardstat: byte absolute $0040:$0017; { the aforementioned location }ππ{-----------------------------------------------------------------------------}ππprocedure new09h; interrupt; { new keyboard handler: it checks if you'veπ pressed "Ctrl", "Alt" and "Delete"; if youπ have, it changes "Ctrl" and "Alt" toπ "undepressed". Then it calls theπ "old" keyboard handler. }πbeginπ if port[$60] and $1d = $1d then ctrldown := (port[$60] < 128);π if port[$60] and $38 = $38 then altdown := (port[$60] < 128);π if port[$60] and $53 = $53 then deldown := (port[$60] < 128);π if ctrldown and altdown and deldown then beginπ keyboardstat := keyboardstat and not ctrlbyte; { By killing the "Ctrl" }π keyboardstat := keyboardstat and not altbyte; { and "Alt" bits, the }π end; { "reboot" never runs }π asmπ pushfπ end;π old09h;π end;ππ{-----------------------------------------------------------------------------}ππbeginπ getintvec($09, @old09h);π setintvec($09, @new09h); { set up new keyboard handler }π ctrldown := false;π altdown := false; { Set "Ctrl", "Alt", "Delete" to "False" }π deldown := false;π keep(0);π end.π 24 05-25-9408:24ALL ALEX KARIPIDIS Listing TSR's SWAG9405 26 /Å {πWell, here it is, a program that lists TSRs loaded.πAnybody willing to enhance it so that it checks the HMA for TSRs too?ππOh, were do I send this so that it gets into the next SWAGS release? I wasπunable to find such a program in the all the SWAGS until (and inclusive) theπlatest February '94 release...ππ{ ------------ Cut Here ----------- }ππProgram ListTSRs;ππ{π Written by Alex Karipidis on the 8th of March 1994.π Donated to the public domain. Use this code freely.ππ You can contact me at:π Fidonet : 2:410/204.4π Hellasnet: 7:2000/50.4π SBCnet : 14:2100/201.4π Zyxelnet : 16:800/108.4π Pascalnet: 115:3005/1.4ππ If you enhance/improve this code in any way, I would appreciate it if youπ sent me a copy of your version.ππ I will not be responsible for any damage caused by this code.ππ This program will print a list of all programs currently loaded inπ memory.π}ππTypeππ pMCB_Rec = ^MCB_Rec;π MCB_Rec = Recordπ ChainID : Byte; { 77 if part of MCB chain, 90 if last MCB allocated }π Owner : Word; { PSP segment address of the MCB's owner }π Paragraphs : Word; { Paragraphs related to this MCB }π end;ππVarπ MCB : pMCB_Rec;π InVarsSeg, InVarsOfs : Word;π EnvSeg, Counter : Word;ππbeginπ { Dos service 52h returns the address of the DOS "invars" table in ES:BX }π { !!! This is an undocumented DOS function !!! }π asmπ MOV AH,52hπ INT 21hπ MOV InVarsSeg,ESπ MOV InVarsOfs,BXπ end;ππ {π The word before the "invars" table is the segment of the first MCBπ allocated by DOS.π }π MCB := Ptr (MemW [InVarsSeg:InVarsOfs-2], 0);ππ While MCB^.ChainID <> 90 do { While valid MCBs exist... }π beginππ If MCB^.Owner = Seg (MCB^) + 1 then { If MCB owns itself, then... }π beginπ Write ('In memory: '); { We've found a program in memory }ππ {π The word at offset 2Ch of the program's PSP contains the value ofπ the program's environment data area. That's were the program's nameπ is located.π }π EnvSeg := MemW [MCB^.Owner:$2C];ππ {π The environment also contains the environment variables as ASCIIZπ (null-terminated) strings. Two consecutive null (0) bytes mean thatπ the environment variables have ended and the program name followsπ after 4 bytes. That is also an ASCIIZ string.π }π Counter := 0;π While (Mem [EnvSeg:Counter ] <> 0) or { Find 2 consecutive }π (Mem [EnvSeg:Counter+1] <> 0) do { null bytes. }π inc (counter);ππ inc (counter,4); { Program name follows after 4 bytes }ππ While Mem [EnvSeg:Counter] <> 0 do { Print program name }π beginπ Write (Char (Mem [EnvSeg : Counter]));π Inc (counter);π end;ππ WriteLn;ππ end;ππ { Point to next MCB }π MCB := Ptr (Seg (MCB^) + MCB^.Paragraphs + 1, 0);π end;ππ {π Note: The last MCB is not processed!π It is assumed that it is this program's MCB.π In your programs, this may or may not be the case.π }ππend.π 25 08-24-9413:27ALL JUAN JOSE VERGARA TSR SWAG9408 è╠ç┬ 11 /Å π{ This TSR, when press Crtl+Print Screen save to disk the screen. }π{Antonio Moro's routines, from Spain TP Echo}π{$M 1024, 0, 0} (* 1 K for Stack *)π{$S-}πPROGRAM Caza;πUSES Dos, Crt;πVAR numfichero : Byte;π fichero : File;π s_num, drive : String [2];π buffg : Pointer;ππPROCEDURE Graba (Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP: Word);πINTERRUPT;π Beginπ Str(numfichero,s_num);π Inc(numfichero);π Assign(fichero, drive + 'SCREEN.' + s_num);π Rewrite(fichero,1);π buffg:= Ptr($B000,0); (* Hercules video memory direction *)π BlockWrite(fichero,buffg^,32768); (* save 32K block of video memory π in a file*)π Close(fichero);π End;ππBEGINπ If ParamCount = 1 Then drive:=ParamStr(1) + ':'π Else drive:='C:';π Writeln;π HighVideo;π Writeln('Resident Savescreen.');π Write('For activate press SHIFT + PRTSCR');π LowVideo;π Writeln;π numfichero:=0;π SetINtVec(5, @Graba); (* Change interrupt vector of 5 interruptionπ (print screen) *) π Keep(0); (* End and Stay Resident *)ππEND.π 26 08-24-9413:41ALL ALWIN LOECKX Grab A $13-Image TSR SWAG9408 {e\$ 11 /Å π{$m $800,0,0 }ππprogram catch; { just for Swag }ππuses crt, dos;ππconst header : array[1..2] of word = (320, 200);ππvar cnt : byte;ππ{$f+}πprocedure new_int; interrupt;ππvar imgfile : file;π imgname : string[12];ππbeginπ str(cnt, imgname);π if cnt < 10 then imgname := '0'+imgname;π if cnt < 100 then imgname := '0'+imgname;π imgname := 'grab.'+imgname;ππ {$i-}π assign(imgfile, imgname);π rewrite(imgfile, 1);ππ blockwrite(imgfile, header, 4);π blockwrite(imgfile, mem[$a000:$0], 320*200);ππ close(imgfile);π {$i+}ππ if ioresult <> 0 thenπ beginπ sound(1000); { Error }π delay(1000);π nosound;π endπ elseπ beginπ sound(50); { Ok! }π delay(50);π nosound;π inc(cnt);π end;πend;π{$f-}πππbeginπ cnt := 1;ππ setintvec($5, addr(new_int));ππ writeln('Press Screen Print to grab a 320x200x256 image to "grab.###"');π writeln('One short low beep means "No error", a long high one means trouble');π writeln;π writeln('Only catch when you''re sure:');π writeln('∙Your hard-disk is not busy');π writeln('∙You''re in a program (so not at the command-prompt)');π writeln('∙You''re in the mcga 320x200 256 color modus ($13)');ππ keep(0);πend.ππWarning!πDo NOT run this program from within Tp!πJust compile it, then run it as an executable.π 27 08-24-9413:44ALL LUIS MEZQUITA Tsr's In Turbo Pascal SWAG9408 ╕┬£ 11 /Å Program TSR;ππ{ TSR Demo }π{ (c) Jul 94 Luis Mezquita Raya }ππ{$M $1000,0,0}ππuses Crt,Dos;ππvar OldInt09h:procedure;ππProcedure EndTSR; assembler;πasmπ cliπ mov AH,49hπ mov ES,PrefixSegπ push ESπ mov ES,ES:[2Ch]π int 21hπ pop ESπ mov AH,49hπ int 21hπ stiπend;ππ{$f+}πProcedure NewInt09h; interrupt;πvar k:byte; kb_exit:boolean;πbeginπ k:=Port[$60];π kb_exit:=False;π if k<$80π then beginπ Sound(5000);π Delay(1);π NoSound;π endπ else if k=$CE { $4E or $80 }π then kb_exit:=True;π asm pushf end;π OldInt09h;π if kb_exitπ then beginπ Sound(440);π Delay(15);π NoSound;π SetIntVec(9,@OldInt09h);π EndTSR;π end;πend;π{$f-}ππbeginπ GetIntVec(9,@OldInt09h);π SetIntVec(9,@NewInt09h);π Keep(0);πend.π>--- cut here -----------------------------------------------------ππ When you run this program you get a key-click each time youπpress a key but TSR program discharges if you press the big '+' keyπ(at numeric keyboard).ππ Greetings,π Luisππ 28 08-24-9413:56ALL JUAN JOSE VERGARA TSR Screen Saver SWAG9408 ë²■ 12 /Å {This is a Screen saver, that passed X time blank screen if no pressed a Key}ππ{ - TSR.PAS - }ππ{$M 6000,0,0}π{$R-,S-,I-,D+,F+,V-,B-,N-,L+}ππUses Dos,Crt,Graph,Screen;π{ The code for SCREEN.PAS is in the SCREEN.SWG file }πConstπ KeyBdInt = $09;π TimerInt = $08;π ScreenOn:Boolean = True;π Seconds = 10; {Time to activate}π Counter:Word = 0;πVarπ Regs:Registers;π OldKbdVec,OldTimerVec:Pointer;π S:ScreenStore;πProcedure STI; Inline($FB);πProcedure CLI; Inline($FA);πProcedure CallOldInt(Sub:Pointer);π Beginπ Inline($9C/$FF/$5E/$06);π End;πProcedure KeyBoard(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP:Word); Interrupt;π Beginπ Counter:=0;π If Not(ScreenOn) Thenπ Beginπ S.RestoreScreen;π ScreenOn:=True;π End;π CallOldInt(OldKbdVec);π STI;π End;πProcedure Timer(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP:Word); Interrupt;π Beginπ If ScreenOn Thenπ Beginπ Inc(Counter);π If Counter>(Trunc(18.2*Seconds)) Thenπ Beginπ S.StoreScreen;π ClrScr;π ScreenOn:=False;π End;π End;π CallOldInt(OldTimerVec);π STI;π End;πBeginπS.Init(1,1,178,7);πGetIntVec(KeyBdInt,OldKbdVec);πSetIntVec(KeyBdInt,@KeyBoard);πGetIntVec(TimerInt,OldTimerVec);πSetIntVec(TimerInt,@Timer);πKeep(0);ππEnd.π 29 08-25-9409:11ALL ERIK ANDERSON Screen Scrool TSR SWAG9408 ªw∞▀ 49 /Å {π>Basically a function that allows me to have 3 lines at the top non scrollablπ>(that I can change, the content of the lines), but so the stuff underthemπ>scrolles...ππWell, when you don't like the way the BIOS scrolls the screen, changeπthe BIOS!ππHere's an interesting program that I just wrote for this purpose. Itπinstalls a TSR-like program that interferes with the BIOS scroll-upπroutine and forces the top to be a variable you set.ππWhile debugging the program, I ran into a bit of trouble with the wayπthat TP handles interrupts. If you notice, half of the ISR has turnedπinto restoring the registers that TP trashes!π}πUses Dos, Crt; {Crt only used by main pgm}ππvarπ TopLine : byte;π OldInt : Procedure;ππ{Procedure Catch is the actual ISR, filtering out BIOS SCROLL-UP commands, andπ forcing the top of the scroll to be the value [TopLine] }ππ{$F+}πprocedure Catch(Flags, rCS, rIP, rAX, rBX, rCX, rDX, rSI, rDI, rDS, rES, rBP: Word); Interrupt;π{ Procedure Catch; interrupt;}π begin {Catch}π asmπ MOV AX, Flagsπ SAHFπ MOV AX, rAXπ MOV BX, rBXπ MOV CX, rCXπ MOV DX, rDXπ MOV SI, rSIπ MOV DI, rDIπ CMP AH, 06π JNE @Passπ CMP CH, TopLineπ JA @Passπ MOV CH, TopLineππ@Pass:π end;π OldInt; {Pass through to old handler}π asmπ MOV rAX, AXπ MOV rBX, BXπ MOV rCX, CXπ MOV rDX, DXπ MOV rSI, SIπ MOV rDI, DIπ end;π end; {Catch}π{$F-}ππ Procedure Install;π beginπ GetIntVec($10, Addr(OldInt));π SetIntVec($10, Addr(Catch));π end;ππ Procedure DeInstall;π beginπ SetIntVec($10, Addr(OldInt));π end;ππbeginπ ClrScr;π DirectVideo := TRUE;π TopLine := 5; {Keep 5+1 lines at top of screen}π Install;π while true do readln;πend.ππ{π>p.p.s I also need a routine (preferably in Turbo Pascal 7 ASM) that saves tπ> content of the current screen in an ANSI file on the disk. I saw oneπ> a while ago in SWAG, but I can't seem to find it now (I'm a dist siteπ> but still can't find it).ππAlso, since I didn't have anything better to do, I sat down and did aπversion of your screen->ANSI. It's rather primitive... it does a 80x24πdump with auto-EOLn seensing, does no CRLF if the line is 80 chars longπ(relies on screen wrap) and no macroing. If you want to, you can addπmacroing, which replaces a number of spaces with a single ANSI 'setπcursor' command. Well, here goes...ππ}π Procedure Xlate(var OutFile : text); {by Erik Anderson}π {The screen is basically an array of elements, each element containing oneπ a one-byte character and a one-byte color attribute}π constπ NUMROWS = 25;π NUMCOLS = 80;π typeπ ElementType = recordπ ch : char;π Attr : byte;π end;π ScreenType = array[1..NUMROWS,1..NUMCOLS] of ElementType;ππ {The Attribute is structured as follows:π bit 0: foreground blue elementπ bit 1: " green elementπ bit 2: " red elementπ bit 3: high intensity flagπ bit 4: background blue elementπ bit 5: " green elementπ bit 6: " red elementπ bit 7: flash flagππ The following constant masks help the program acess different partsπ of the attribute}π constπ TextMask = $07; {0000 0111}π BoldMask = $08; {0000 1000}π BackMask = $70; {0111 0000}π FlshMask = $80; {1000 0000}π BackShft = 4;ππ ESC = #$1B;ππ {ANSI colors are not the same as IBM colors... this table fixes theπ discrepancy:}π ANSIcolors : array[0..7] of byte = (0, 4, 2, 6, 1, 5, 3, 7);ππ {This procedure sends the new attribute to the ANSI dump file}π Procedure ChangeAttr(var Outfile : text; var OldAtr : byte; NewAtr : byte);π varπ Connect : string[1]; {Is a seperator needed?}π beginπ Connect := '';π write(Outfile, ESC, '['); {Begin sequence}π If (OldAtr AND (BoldMask+FlshMask)) <> {Output flash & blink}π (NewAtr AND (BoldMask+FlshMask)) then beginπ write(Outfile, '0');π If NewAtr AND BoldMask <> 0 then write(Outfile, ';1');π If NewAtr AND FlshMask <> 0 then write(Outfile, ';5');π OldAtr := $FF; Connect := ';'; {Force other attr's to print}π end;ππ If OldAtr AND BackMask <> NewAtr AND BackMask then beginπ write(OutFile, Connect,π ANSIcolors[(NewAtr AND BackMask) shr BackShft] + 40);π Connect := ';';π end;ππ If OldAtr AND TextMask <> NewAtr AND TextMask then beginπ write(OutFile, Connect,π ANSIcolors[NewAtr AND TextMask] + 30);π end;ππ write(outfile, 'm'); {Terminate sequence}π OldAtr := NewAtr;π end;ππ {Does this character need a changing of the attribute? If it is a space,π then only the background color matters}ππ Function AttrChanged(Attr : byte; ThisEl : ElementType) : boolean;π varπ Result : boolean;π beginπ Result := FALSE;π If ThisEl.ch = ' ' then beginπ If ThisEl.Attr AND BackMask <> Attr AND BackMask thenπ Result := TRUE;π end else beginπ If ThisEl.Attr <> Attr then Result := TRUE;π end;π AttrChanged := Result;π end;ππ varπ Screen : ScreenType absolute $b800:0000;π ThisAttr, TestAttr : byte;π LoopRow, LoopCol, LineLen : integer;π begin {Xlate}π ThisAttr := $FF; {Force attribute to be set}π For LoopRow := 1 to NUMROWS do beginππ LineLen := NUMCOLS; {Find length of line}π While (LineLen > 0) and (Screen[LoopRow, LineLen].ch = ' ')π and not AttrChanged($00, Screen[LoopRow, LineLen])π do Dec(LineLen);ππ For LoopCol := 1 to LineLen do begin {Send stream to file}π If AttrChanged(ThisAttr, Screen[LoopRow, LoopCol])π then ChangeAttr(Outfile, ThisAttr, Screen[LoopRow, LoopCol].Attr);π write(Outfile, Screen[LoopRow, LoopCol].ch);π end;π If LineLen < 80 then writeln(OutFile); {else wraparound occurs}π end;π end; {Xlate}ππvarπ OutFile : text;πbeginπ Assign(OutFile, 'dump.scn');π Rewrite(OutFile);π Xlate(OUtFile);π Close(OUtFile);πend.π
