home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BONUS40.ZIP / TPSPL.ZIP / TPSPOOL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-02-02  |  8.4 KB  |  245 lines
  1. {************************************************************************}
  2. {*                                                                      *}
  3. {* TPSPOOL - Print spooler                                              *}
  4. {* Version 1.0 updated 2/2/88                                           *}
  5. {* by Richard Sadowsky                                                  *}
  6. {* Released to the public domain                                        *}
  7. {************************************************************************}
  8. {* TPSPOOL size                                                         *}
  9. {* where size is the size of the spool buffer.  You may use hex numbers *}
  10. {* placing a $ in front (ex. $4000).                                    *}
  11. {*                                                                      *}
  12. {* Use Alt-Tab to toggle spooler on/off (default is off).               *}
  13. {* Turning spooler on will beep the speaker, turning it off will        *}
  14. {* dump the spool buffer.                                               *}
  15. {*                                                                      *}
  16. {************************************************************************}
  17. {$S-,I-,R-,V-}
  18. {$M 2048,0,655360} { program adjusts itself at runtime to use least }
  19.                        { possible amount of memory }
  20. program TPSpool;
  21.  
  22. {DEFINE debug}    { must define useCRT to use debug }
  23. {DEFINE useCRT}   { for debugging }
  24.  
  25. Uses DOS,
  26. { The following Units are from TurboPower's Turbo Professional 4.0 }
  27. {$IFDEF useCRT}
  28.      TPCrt,
  29. {$ENDIF}
  30.  
  31.      TPString,
  32.      TPInt,
  33.      TPTSR;
  34.  
  35. const
  36.   SelectedLPT      : Word = 0;   { default to LPT1 as device to spool }
  37.   SuccessBits      : Byte = $90; { or 10h or whatever you want! I use }
  38.                                  { Advanced MS-DOS by Ray Duncan as a }
  39.                                  { reference. }
  40.   HotKey           = $080F;     { Alt/Tab }
  41.   WaitForDos       = TRUE;      { DOS services needed in popup }
  42.   SpoolBufSize     : Word = $FF00; { 65280 }
  43.   Int17_HANDLE     = 15;
  44.   SpoolOn          : Boolean = FALSE;
  45.   In_PopUp         : Boolean = FALSE;
  46.   ThisModule       : String[8] = 'TPSPOOL_0.6';
  47.   ProgID           =
  48.       'TPSPOOL .6 installed, press <Alt><Tab> to toggle spooler on/off';
  49.   OutFileName      : String[12] = 'SPOOL01.TMP';
  50.  
  51. type
  52.   Str20            = String[20];
  53.   SpoolBufType     = array[1..$FF00] of Byte;
  54.  
  55. var
  56.   TimerHandle      : Byte;
  57.   BetterDumpIt,SafeDumpSize,
  58.   SpoolIndex       : Word;
  59.   SpoolBuf (* ,EmergencySpoolBuf *)
  60.                    : ^SpoolBufType;
  61.   OutFile          : File;
  62.  
  63. function LongWMul(X,Y : Word) : LongInt;
  64. { multiplies two words and returns a longint, VERY FAST }
  65. Inline(
  66.   $5A/                   {pop    dx        ; get Y}
  67.   $58/                   {pop    ax        ; get x}
  68.   $F7/$E2);              {mul    dx        ; multiply Y*X return in DX:AX}
  69.  
  70. procedure DumpSpoolBuf;
  71. { Dump the spool buffer to disk if necessary }
  72. var
  73.   E                : Word;
  74.   Handle,Num       : Word;
  75.   FilePos          : LongInt;
  76.   P                : Pointer;
  77.  
  78. begin
  79.   InterruptsOff;
  80.   if SpoolIndex <= 1 then begin { if there's anything in the spooler }
  81.     InterruptsOn;
  82.     Exit; { nothing to dump }
  83.   end;
  84.  
  85.   Assign(OutFile,OutFileName);  { Open the spool file }
  86.   Reset(OutFile,1);
  87.   if IOresult <> 0 then
  88.     Rewrite(OutFile,1)          { not found so create it }
  89.   else
  90.     Seek(OutFile,FileSize(OutFile)); { prepare for appending }
  91.   BlockWrite(OutFile,SpoolBuf^[1],Pred(SpoolIndex),Num); { dump the buffer }
  92.   Close(OutFile);
  93.   InterruptsOff;
  94.   SpoolIndex := 1;  { reset spool index to beginning }
  95.   InterruptsOn;
  96. end;
  97.  
  98. {$F+}
  99. procedure PopUpEntry(var Regs : Registers);
  100. { User has pressed the hot key, so process it }
  101. begin
  102.   InterruptsOff;
  103.   In_PopUp := TRUE; { set semaphore for future multitasking }
  104.   InterruptsOn;
  105.   if SpoolBuf = NIL then   { if the spool buffer hasn't been allocated, }
  106.     GetMem(SpoolBuf,SpoolBufSize); { then allocate the memory on the heap }
  107.   SpoolOn := Not SpoolOn;  { toggle spooler }
  108.   if SpoolOn then begin
  109.  
  110. {$IFDEF useCRT}
  111.     { two tone beep at the user }
  112.     Sound(220);
  113.     Delay(600);
  114.     Sound(880);
  115.     Delay(300);
  116.     NoSound;
  117.  
  118. {$ELSE}
  119.  
  120.     Write(^G); { simple beep at user }
  121.  
  122. {$ENDIF}
  123.  
  124.   end
  125.   else
  126.     DumpSpoolBuf; { Spooler disabled so dump the buffer }
  127.   InterruptsOff;
  128.   In_PopUp := FALSE; { clear semaphore for future multitasking }
  129.   InterruptsOn;
  130. end;
  131. {$F-}
  132.  
  133. {$F+}
  134. procedure TimerISR(var Regs : Registers);
  135. { We have control and it's safe to call DOS, so check to see if the }
  136. { buffer needs dumping, and dump if necessary }
  137. begin
  138.   InterruptsOff;
  139.   if SpoolIndex > BetterDumpIt then begin { if the spooler needs dumping }
  140.     InterruptsOn;
  141.     DumpSpoolBuf; { dump it }
  142.   end
  143.   else
  144.     InterruptsOn;
  145. end;
  146. {$F-}
  147.  
  148.   procedure Trap_Int17(BP : Word); interrupt;
  149.   { If spooler is on, capture calls to ROM BIOS interrupt 17h, if the call is }
  150.   { to print a character, add it to spool buffer. }
  151.   var
  152.     Regs             : IntRegisters absolute BP;
  153.  
  154.   begin
  155.     if SpoolOn and (Regs.Dx = SelectedLPT) then begin
  156.       { if spooler enabled and right LPTNo then spool the char }
  157.       InterruptsOff;
  158.       if Regs.Ah = $0 then begin { If this is a char write to printer, spool }
  159.                                { it. If not a print call, the call is NOT  }
  160.                                { filtered to prevent hanging on machines   }
  161.                                { without any printer. (see docs }
  162.         SpoolBuf^[SpoolIndex] := Regs.Al; { put the character in the spool buf }
  163.         Inc(SpoolIndex);                  { increment index }
  164.  
  165.         if (SpoolIndex > BetterDumpIt) then { if buffer needs a-dumpin }
  166.           SetPopTicker(TimerHandle,144);  { try to gain access to DOS services }
  167.       end;
  168.       Regs.Ah := SuccessBits;             { set bits to indicate success }
  169.       InterruptsOn;
  170.     end
  171.     else
  172.       ChainInt(Regs,ISR_Array[Int17_HANDLE].OrigAddr); { just filter it }
  173.   end;
  174.  
  175. function InitISRs : Boolean;
  176. { Set's up ISRs and popup routines.  Also sets the buffer size. }
  177. var
  178.   Num  : Word;
  179.  
  180. begin
  181.   if ParamCount > 0 then    { if user specified a command line option }
  182.     if Str2Word(ParamStr(1),Num) then { is it a valid number? }
  183.       SpoolBufSize := Num;            { If so, set buffer size equal to it }
  184.   BetterDumpIt := SpoolBufSize Div 2; { Dump if greater than half full }
  185.  
  186.   SpoolIndex := 1; { point to first byte in spool buffer }
  187.   { now set up ISRs and popups }
  188.   InitISRs :=
  189.    { Hot key popup }
  190.    DefinePop(HotKey,@PopUpEntry,Ptr(SSeg,SPtr), WaitForDos) and
  191.  
  192.    { popup to allow buffer to be dumped }
  193.    DefinePopProc(TimerHandle,@TimerISR,Ptr(SSeg,SPtr)) and
  194.  
  195.    { Int 17h handler, traps calls to BIOS to print a character }
  196.    InitVector($17,Int17_HANDLE,@Trap_Int17)
  197. end;
  198.  
  199. var
  200.   ResidentSizeInParas : Word; { Number of paragraphs needed at runtime }
  201.   NumBytesUsed : LongInt;     { Number of bytes used at runtime }
  202.  
  203. begin { main }
  204.   if ModuleInstalled(ThisModule) then begin { already installed? }
  205.     WriteLn('TPSPOOL already installed.'); { already RAM resident }
  206.     Exit
  207.   end;
  208.   if InitISRs then begin { ISR and popups initialize OK? }
  209.     WriteLn(ProgID);     { Program ID }
  210.  
  211. {$IFDEF debug}
  212.     WriteLn('Debug On');
  213. {$ENDIF}
  214.  
  215. {$IFDEF useint21}
  216.     WriteLn('Using radical Int 21h handler');
  217. {$ENDIF}
  218.  
  219.     WriteLn('Spool file name: ',OutFileName); { display spool file name }
  220.     { tell the user the runtime size in bytes of this program }
  221.     WriteLn('Using ',SpoolBufSize,' byte spool buffer in RAM');
  222.     { Disable TPCrt's  Ctrl Break handler }
  223.  
  224. {$IFDEF useCRT}
  225.  
  226.     SetIntVec($1B, SaveInt1B); { mandatory if CRT or TPCRT are used }
  227.  
  228. {$ENDIF}
  229.  
  230.     InstallModule(ThisModule,NIL); { Set up shop, see TProf4 manual }
  231.     PopUpsOn; { enable the popup routines }
  232.     SpoolBuf := NIL; { initialize this to NIL }
  233.     { Calculate the number of paragraphs of RAM needed at runtime }
  234.     ResidentSizeInParas :=  ParagraphsToKeep + Succ(SpoolBufSize div 16);
  235.     { User could care less about paragraphs, tell them in bytes }
  236.     NumBytesUsed := LongWMul(ResidentSizeInParas,16);
  237.     WriteLn;
  238.     WriteLn('Going resident, using ',NumBytesUsed,' bytes');
  239.     { Let's go resident now }
  240.     if not TerminateAndStayResident(ResidentSizeInParas,0) then {do nothing};
  241.   end;
  242.  
  243.   WriteLn('Unable to install TPSPOOL.'); { something went wrong!!! }
  244. end. {main}
  245.