home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR16
/
SPOOLAQ.ZIP
/
SPOOLER.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-06-12
|
26KB
|
599 lines
(* █▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█ *)
(* █ █ *)
(* █ S P O O L E R - Object █ *)
(* █ █ *)
(* ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ *)
unit Spooler;
{ F+}
{$O+} (* can be put in an overlay *)
interface
uses
DOS, Printer,
Objects, Views, Drivers, App;
(* ╔════════════════════════════════════════════════════════════════╗ *)
(* ║ ║ *)
(* ║ definition of exported constants ║ *)
(* ║ ║ *)
(* ╚════════════════════════════════════════════════════════════════╝ *)
const
Spool_LPT1 = 1;
Spool_LPT2 = 2;
Spool_COM1 = 1;
Spool_COM2 = 2;
Spool_COM3 = 3;
Spool_COM4 = 4;
Spool_300 = 0;
Spool_600 = 1;
Spool_1200 = 2;
Spool_2400 = 3;
Spool_4800 = 4;
Spool_9600 = 5;
Spool_Odd = 0;
Spool_Even = 1;
Spool_1Stop = 0;
Spool_2Stop = 1;
Spool_8Bit = 0;
Spool_7Bit = 1;
Spool_FlowXONXOFF = 0;
Spool_FlowDTR = 1;
(* ╔════════════════════════════════════════════════════════════════╗ *)
(* ║ ║ *)
(* ║ definition of object ║ *)
(* ║ ║ *)
(* ╚════════════════════════════════════════════════════════════════╝ *)
type
PSpooler = ^TSpooler;
TSpooler = object (TView )
constructor Init( Rect : TRect; NameOfFile : String );
destructor Done; virtual;
procedure SetParallel( PortNo : word ); virtual;
procedure SetSerial( PortNo,
BaudRate,
DataBits,
StopBits,
Parity,
FlowControl : word ); virtual;
procedure StartSpooling; virtual;
procedure StopSpooling; virtual;
procedure CancelSpooling; virtual;
procedure SpoolOneChar; virtual;
procedure Draw; virtual;
procedure Update; virtual;
procedure UseDOS( Flag : boolean ); virtual;
private
Active : boolean; (* spool-process is active *)
FileName : PString; (* name of file to output *)
SizeOfFile : longint; (* end-marker *)
Remainder : longint; (* no. of bytes to handle *)
NextChar : byte; (* the next char. for output *)
NextCharPtr : longint; (* Ptr. into file *)
IsParallel : boolean; (* to parallel/serial port ? *)
PortAddress : word; (* address of the port *)
SpoolFile : file; (* file for reading *)
lastTimerTicks : longint; (* needed for update of no. *)
FlowOfControl : word; (* which type of control ? *)
XOFF_Flag : boolean; (* XOFF sent ? *)
DirectHWAccess : boolean; (* use OUT-instr. or DOS-calls *)
procedure DeQueue;
function StatusLPT : boolean;
function COMGetc( COMx : word) : word;
function COMPutc(COMx:word; CommandChar:byte) : word;
function COMPutC_DTR(COMx:word; CommandChar:byte) : word;
end;
implementation
(* ╔════════════════════════════════════════════════════════════════╗ *)
(* ║ ║ *)
(* ║ definition of private constants ║ *)
(* ║ ║ *)
(* ╚════════════════════════════════════════════════════════════════╝ *)
const
XON = #$11;
XOFF = #$13;
(* ╔════════════════════════════════════════════════════════════════╗ *)
(* ║ ║ *)
(* ║ the Spooler-object ║ *)
(* ║ ║ *)
(* ╚════════════════════════════════════════════════════════════════╝ *)
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ construct the Spool-object │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
constructor TSpooler.Init( Rect : TRect; NameOfFile : String );
begin
TView.Init( Rect );
FileName := NewStr( NameOfFile );
Active := false;
NextCharPtr := 0;
NextChar := 0;
SizeOfFile := 0;
lastTimerTicks := 0;
IsParallel := true; (* default: parallel *)
PortAddress := MemW[$40:8]; (* = LPT1 *)
DirectHWAccess := true;
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ remove Spool-object │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
destructor TSpooler.Done;
var
f : file;
begin
if Active then
CancelSpooling;
DisposeStr( FileName );
TView.Done;
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ init of parallel interface │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
procedure TSpooler.SetParallel( PortNo : word );
begin
IsParallel := true;
PortAddress := MemW[$40:(3+PortNo) shl 1];
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ init of serial interface │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
procedure TSpooler.SetSerial( PortNo,
BaudRate,
DataBits,
StopBits,
Parity,
FlowControl : word );
var
CommRegs : Registers;
begin
IsParallel := false;
PortAddress := MemW[$40:(PortNo-Spool_COM1) shl 1];
FlowOfControl := FlowControl;
XOFF_Flag := false; (* status = XON *)
with CommRegs do
begin
(* interpretation: look at BIOS, INT 14H, function 0 = init *)
AH := 0;
case BaudRate of
{ Spool_110 : AL := $00; }
{ Spool_150 : AL := $20; }
Spool_300 : AL := $40;
Spool_600 : AL := $60;
Spool_1200 : AL := $80;
Spool_2400 : AL := $A0;
Spool_4800 : AL := $C0;
Spool_9600 : AL := $E0;
end;
case Parity of
Spool_Odd : AL := AL or $08;
Spool_Even : AL := AL or $18;
end;
case StopBits of
Spool_1Stop : AL := AL or $00;
Spool_2Stop : AL := AL or $04;
end;
case DataBits of
Spool_8Bit : AL := AL or $03;
Spool_7Bit : AL := AL or $02;
end;
DX := PortNo-Spool_COM1; (* no. of port: 0=COM1, 1=COM2 etc. *)
end;
Intr($14,CommRegs);
end; (* ---------------------------------------------- SetSerial *)
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ start the spooling-process │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
procedure TSpooler.StartSpooling;
begin
if not Active then
begin
assign( SpoolFile, FileName^);
reset( SpoolFile, 1 );
SizeOfFile := FileSize( SpoolFile );
if SizeOfFile>0 then
begin
seek( SpoolFile, NextCharPtr );
blockread( SpoolFile, NextChar, 1 );
Active := true;
end
else
close( SpoolFile );
end;
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ stop (or pause) the spooling-process │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
procedure TSpooler.StopSpooling;
begin
if Active then
begin
close( SpoolFile );
Active := false;
end;
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ final work: stop spooling-process │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
procedure TSpooler.CancelSpooling;
begin
if Active then
StopSpooling;
assign( SpoolFile, FileName^);
reset( SpoolFile, 1);
(* do not truncate in development-process, remove comments later ! *)
{ truncate( SpoolFile ); } (* !!!!! look here ! !!!!!!!!! *)
(* ^^^^^^^^^^^^^^^^^^^^^^ *)
close( SpoolFile );
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ output one character │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
procedure TSpooler.SpoolOneChar;
var
CommResult : word;
begin
if Active then
begin
if DirectHWAccess then
begin
(* ------------------------------------------------------------------ *)
(* *)
(* use the parallel interface *)
(* *)
(* ------------------------------------------------------------------ *)
if IsParallel then
begin
if StatusLPT then
begin
PORT[PortAddress]:=NextChar;
DeQueue;
PORT[PortAddress+2]:=$0d; (* set strobe-bit *)
PORT[PortAddress+2]:=$0c; (* reset strobe-bit *)
end;
end
else
(* ------------------------------------------------------------------ *)
(* *)
(* use serial interface *)
(* *)
(* ------------------------------------------------------------------ *)
begin
if FlowOfControl=Spool_FlowXONXOFF then
begin
(* *)
(* flow of control is XON/XOFF *)
(* *)
if not XOFF_Flag then
if COMPutC( PortAddress, NextChar )=word(NextChar) then
DeQueue;
CommResult := COMGetC( PortAddress );
if CommResult <= $FF then
XOFF_Flag := (CommResult=word(XOFF));
end
else
begin
(* *)
(* flow of control is DTR *)
(* *)
if COMPutC_DTR( PortAddress, NextChar)=word(NextChar) then
Dequeue;
end;
end;
end
else
begin
(* ------------------------------------------------------------------ *)
(* *)
(* output a byte using DOS *)
(* *)
(* ------------------------------------------------------------------ *)
write(Lst, char(NextChar));
DeQueue;
end;
end;
Remainder := SizeOfFile - NextCharPtr;
Update;
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ show the number of remaining bytes in the given rectangle │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
procedure TSpooler.Draw;
var
Buf : TDrawBuffer;
Value : string;
Params : array [0..0] of longint;
begin
if Remainder>0 then
begin
Params[0] := Remainder;
FormatStr( Value, '%8d', Params);
MoveStr( Buf, Value, GetColor(2));
end
else
MoveChar(Buf, ' ', GetColor(2), 8);
WriteLine(0, 0, size.x, 1, Buf);
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ must we update the contents of the View ? │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
procedure TSpooler.Update;
var BIOSTimerTicks : longint absolute $40:$6c;
begin
if BIOSTimerTicks>=lastTimerTicks then
begin
TSpooler.DrawView;
(* it's enough to show it 6 times a second, so add 2 *)
lastTimerTicks := BIOSTimerTicks+2;
end;
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ OK, we will not directly access the hardware │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
procedure TSpooler.UseDOS( Flag : boolean );
begin
DirectHWAccess := not Flag;
end; (* ---------------------------------------------- UseDOS *)
(* ╔════════════════════════════════════════════════════════════════╗ *)
(* ║ ║ *)
(* ║ the private methods ║ *)
(* ║ ║ *)
(* ╚════════════════════════════════════════════════════════════════╝ *)
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ take the next character from queue-file │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
procedure TSpooler.DeQueue;
begin
inc(NextCharPtr);
if NextCharPtr<SizeOfFile then
blockread( SpoolFile, NextChar, 1)
else
(* End of File-condition: *)
CancelSpooling;
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ status of parallel interface │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
function TSpooler.StatusLPT : boolean;
var
Status : byte;
begin
Status := PORT[PortAddress+1];
if (Status and $90)=$80 then (* test bit #7 & #4 *)
StatusLPT := false (* turned off or offline *)
else if (Status and $20)=$20 then (* test bit #5 *)
StatusLPT := false (* Out of paper *)
else if (Status and $B8)=$98 then (* test Bit #7, #5, #4 & #3 *)
StatusLPT := true
else
StatusLPT := false; (* offline *)
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ fetch character from the serial interface │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
function TSpooler.COMGetc( COMx : word) : word;
var
V24_ErrNo : byte; { error-no. }
begin
asm
{ read 1 byte from SIO
; returns: AL contains char.
; AH error
$0000 = no character read }
MOV DX,COMx { DX contains the port-no. of SIO }
PUSH DX
PUSH CX
PUSH BX
MOV V24_ErrNo,0 { init: no error occured }
ADD DX,5 { DX (new) = DX(old)+5 }
@READ00: { printer will send char
check: char. available }
@READ01: IN AL,DX { DX = Line Status Register }
TEST AL,00011110B { error occured ? }
{ ^^^^^----> data received }
{ IIII-----> overrun error }
{ III------> parity error }
{ II-------> framing error }
{ I--------> break received }
JZ @READ02
MOV V24_ErrNo,AL { store error }
@READ01A: MOV AL,0 { return: no char. }
OR V24_ErrNo, $80
JMP @READERR
@READ02: TEST AL,1 { Char ready ? }
JZ @READ01A { No: return $0000 }
@READ03: MOV AX,5 { fetch character }
SUB DX,AX
IN AL,DX { DX = Receiver Buffer }
{ AL: character received }
@READERR: MOV AH,V24_ErrNo
MOV @Result,AX { return char. + error-code }
POP BX
POP CX
POP DX
end;
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ send character to printer if possible │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
function TSpooler.COMPutc(COMx:word; CommandChar:byte) : word;
var
V24_ErrNo : byte; { error-no. }
begin
asm
{ write 1 char. in SIO }
{ returns: AL CommandChar / $00 }
{ AH error-no. }
{ $00 = OK }
{ else: error }
MOV DX,COMx { DX contains port-no. of SIO }
PUSH DX
MOV V24_ErrNo,0 { init: no error occured }
@WRITE02:
ADD DX,5 { DX = COMx + 5 }
{; SIO erlaubt Übergabe }
@WRITE03: IN AL,DX { DX = Line Status Register }
TEST AL,00011110B { error occured ? }
{ ^^^^^----> data received }
{ IIII-----> overrun error }
{ III------> parity error }
{ II-------> framing error }
{ I--------> break received }
JZ @WRITE04 { no --> go on }
{ error occured: }
MOV V24_ErrNo,AL { store error }
@WRITE01A:
MOV AL,0 { return: no char }
OR V24_ErrNo, $80
JMP @WRITE06
@WRITE04: TEST AL,20H { Transmitter Holding Reg. empty ? }
JZ @WRITE01A { cannot write: return }
@WRITE05: { can write: }
MOV AX,5
SUB DX,AX
MOV AL,CommandChar { AL contains char. }
OUT DX,AL { DX = Transmitter Register }
{ AL still contains char --> return }
@WRITE06: { return: finishing work }
MOV AH,V24_ErrNo
MOV @Result,AX
POP DX
end;
end;
(* ┌────────────────────────────────────────────────────────────────┐ *)
(* │ │ *)
(* │ send char. to printer, check status of DTR │ *)
(* │ │ *)
(* └────────────────────────────────────────────────────────────────┘ *)
function TSpooler.COMPutC_DTR(COMx:word; CommandChar:byte) : word;
var
V24_ErrNo : byte; { error-no. }
begin
asm
{ write 1 char into SIO }
{ Rückgabe: AL CommandChar / $00 }
{ AH error }
{ $8000 = no char. transmitted }
MOV DX,COMx { DX contains port-no. of SIO }
PUSH DX
MOV V24_ErrNo,0 { init: no error occured }
ADD DX,6 { DX = COMx + 6 }
@WRITE01: IN AL,DX { DX = Modem Status Register }
TEST AL,00100000B { DSR=True: allowed to write }
JNZ @WRITE02
@WRITE01A:
MOV AL,0 { Rückgabe: kein Zeichen }
OR V24_ErrNo, $80
JMP @WRITE06
@WRITE02:
DEC DX { DX (neu) = DX(alt)+5 }
{; transmit allowed }
@WRITE03: IN AL,DX { DX = Line Status Register }
TEST AL,00011110B { error occured ? }
{ ^^^^^----> data received }
{ IIII-----> overrun error }
{ III------> parity error }
{ II-------> framing error }
{ I--------> break received }
JZ @WRITE04 { no --> continue }
{ eror occured: }
MOV V24_ErrNo,AL { store error }
JMP @WRITE01A
@WRITE04: TEST AL,20H { Transmitter Holding Reg. empty ? }
JZ @WRITE01A { cannot write --> return }
@WRITE05: { can write: }
MOV AX,5
SUB DX,AX
MOV AL,CommandChar { AL contians char. }
OUT DX,AL { DX = Transmitter Register }
{ AL still contains char --> return }
@WRITE06: { return: finishing work }
MOV AH,V24_ErrNo
MOV @Result,AX
POP DX
end;
end;
(* ╔════════════════════════════════════════════════════════════════╗ *)
(* ║ ║ *)
(* ║ Init of this Unit ║ *)
(* ║ ║ *)
(* ╚════════════════════════════════════════════════════════════════╝ *)
begin
(* nothing to do ! *)
end.
