home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
TPSPOOL
/
TPSPOOL.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1988-10-11
|
8KB
|
249 lines
{************************************************************************}
{* *}
{* TPSPOOL - Print spooler *}
{* Version .8 8/4/88 *}
{* by Richard Sadowsky *}
{* Released to the public domain *}
{************************************************************************}
{* TPSPOOL size *}
{* where size is the size of the spool buffer. You may use hex numbers *}
{* placing a $ in front (ex. $4000). *}
{* *}
{* Use Alt-Tab to toggle spooler on/off (default is off). *}
{* Turning spooler on will beep the speaker, turning it off will *}
{* dump the spool buffer. *}
{* *}
{************************************************************************}
{$S-,I-,R-,V-}
{$M 2048,0,655360} { program adjusts itself at runtime to use least }
{ possible amount of memory }
program TPSpool;
{DEFINE debug} { must define useCRT to use debug }
{DEFINE useCRT} { for debugging }
Uses DOS,
{ The following Units are from TurboPower's Turbo Professional 4.0 }
{$IFDEF useCRT}
TPCrt,
{$ENDIF}
TPString,
TPInt,
TPTSR;
const
HotKey = $080F; { Alt/Tab }
WaitForDos = TRUE; { DOS services needed in popup }
SpoolBufSize : Word = $FF00; { 65280 }
Int17_HANDLE = 15;
SpoolOn : Boolean = FALSE;
In_PopUp : Boolean = FALSE;
ThisModule : String[8] = 'TPSPOOL_0.8';
ProgID =
'TPSPOOL .8 installed, press <Alt><Tab> to toggle spooler on/off';
OutFileName : String[12] = 'SPOOL01.TMP';
type
Str20 = String[20];
SpoolBufType = array[1..$FF00] of Byte;
var
TimerHandle : Byte;
BetterDumpIt,SafeDumpSize,
SpoolIndex : Word;
SpoolBuf : ^SpoolBufType;
OutFile : File;
function LongWMul(X,Y : Word) : LongInt;
{ multiplies two words and returns a longint, VERY FAST }
Inline(
$5A/ {pop dx ; get Y}
$58/ {pop ax ; get x}
$F7/$E2); {mul dx ; multiply Y*X return in DX:AX}
procedure DumpSpoolBuf;
{ Dump the spool buffer to disk if necessary }
var
E : Word;
Handle,Num : Word;
FilePos : LongInt;
P : Pointer;
begin
InterruptsOff;
if SpoolIndex <= 1 then begin { if there's anything in the spooler }
InterruptsOn;
Exit; { nothing to dump }
end;
Assign(OutFile,OutFileName); { Open the spool file }
Reset(OutFile,1);
if IOresult <> 0 then
Rewrite(OutFile,1) { not found so create it }
else
Seek(OutFile,FileSize(OutFile)); { prepare for appending }
BlockWrite(OutFile,SpoolBuf^[1],Pred(SpoolIndex),Num); { dump the buffer }
Close(OutFile);
InterruptsOff;
SpoolIndex := 1; { reset spool index to beginning }
InterruptsOn;
end;
{$F+}
procedure PopUpEntry(var Regs : Registers);
{ User has pressed the hot key, so process it }
begin
InterruptsOff;
In_PopUp := TRUE; { set semaphore for future multitasking }
InterruptsOn;
if SpoolBuf = NIL then { if the spool buffer hasn't been allocated, }
GetMem(SpoolBuf,SpoolBufSize); { then allocate the memory on the heap }
SpoolOn := Not SpoolOn; { toggle spooler }
if SpoolOn then begin
{$IFDEF useCRT}
{ two tone beep at the user }
Sound(220);
Delay(600);
Sound(880);
Delay(300);
NoSound;
{$ELSE}
Write(^G); { simple beep at user }
{$ENDIF}
end
else
DumpSpoolBuf; { Spooler disabled so dump the buffer }
InterruptsOff;
In_PopUp := FALSE; { clear semaphore for future multitasking }
InterruptsOn;
end;
{$F-}
{$F+}
procedure TimerISR(var Regs : Registers);
{ We have control and it's safe to call DOS, so check to see if the }
{ buffer needs dumping, and dump if necessary }
begin
InterruptsOff;
if SpoolIndex > BetterDumpIt then begin { if the spooler needs dumping }
InterruptsOn;
DumpSpoolBuf; { dump it }
end
else
InterruptsOn;
end;
{$F-}
procedure Trap_Int17(BP : Word); interrupt;
{ If spooler is on, capture calls to ROM BIOS interrupt 17h, if the call is }
{ to print a character, add it to spool buffer. }
var
Regs : IntRegisters absolute BP;
begin
if SpoolOn then begin { if spooler enabled then spool character }
InterruptsOff;
{$IFDEF debug}
{ ******* Use this when debugging }
if SpoolIndex > SpoolBufSize - 1024 then begin
FastWrite(Pad(
'Crash approaching SpoolIndex = '+Long2Str(SpoolIndex),80),25,1,$70);
if SpoolIndex >= SpoolBufSize then begin
InterruptsOn;
Exit;
end;
end;
{$ENDIF}
SpoolBuf^[SpoolIndex] := Regs.Al; { put the character in the spool buf }
Inc(SpoolIndex); { increment index }
if (SpoolIndex > BetterDumpIt) then { if buffer needs a-dumpin }
SetPopTicker(TimerHandle,36); { try to gain access to DOS services }
Regs.Ah := $90; { set bits to indicate success }
InterruptsOn;
end
else
ChainInt(Regs,ISR_Array[Int17_HANDLE].OrigAddr); { just filter it }
end;
function InitISRs : Boolean;
{ Set's up ISRs and popup routines. Also sets the buffer size. }
var
Num : Word;
begin
if ParamCount > 0 then { if user specified a command line option }
if Str2Word(ParamStr(1),Num) then { is it a valid number? }
SpoolBufSize := Num; { If so, set buffer size equal to it }
BetterDumpIt := SpoolBufSize Div 2; { Dump if greater than half full }
SpoolIndex := 1; { point to first byte in spool buffer }
{ now set up ISRs and popups }
InitISRs :=
{ Hot key popup }
DefinePop(HotKey,@PopUpEntry,Ptr(SSeg,SPtr), WaitForDos) and
{ popup to allow buffer to be dumped }
DefinePopProc(TimerHandle,@TimerISR,Ptr(SSeg,SPtr)) and
{ Int 17h handler, traps calls to BIOS to print a character }
InitVector($17,Int17_HANDLE,@Trap_Int17)
end;
var
ResidentSizeInParas : Word; { Number of paragraphs needed at runtime }
NumBytesUsed : LongInt; { Number of bytes used at runtime }
begin { main }
if ModuleInstalled(ThisModule) then begin { already installed? }
WriteLn('TPSPOOL already installed.'); { already RAM resident }
Exit
end;
if InitISRs then begin { ISR and popups initialize OK? }
WriteLn(ProgID); { Program ID }
{$IFDEF debug}
WriteLn('Debug On');
{$ENDIF}
WriteLn('Spool file name: ',OutFileName); { display spool file name }
{ tell the user the runtime size in bytes of this program }
WriteLn('Using ',SpoolBufSize,' byte spool buffer in RAM');
{ Disable TPCrt's Ctrl Break handler }
{$IFDEF useCRT}
SetIntVec($1B, SaveInt1B); { mandatory if CRT or TPCRT are used }
{$ENDIF}
InstallModule(ThisModule,NIL); { Set up shop, see TProf4 manual }
PopUpsOn; { enable the popup routines }
SpoolBuf := NIL; { initialize this to NIL }
{ Calculate the number of paragraphs of RAM needed at runtime }
ResidentSizeInParas := ParagraphsToKeep + Succ(SpoolBufSize div 16);
{ User could care less about paragraphs, tell them in bytes }
NumBytesUsed := LongWMul(ResidentSizeInParas,16);
WriteLn;
WriteLn('Going resident, using ',NumBytesUsed,' bytes');
{ Let's go resident now }
if not TerminateAndStayResident(ResidentSizeInParas,0) then {do nothing};
end;
WriteLn('Unable to install TPSPOOL.'); { something went wrong!!! }
end. {main}