home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
progjour
/
1991
/
04
/
commserv.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-13
|
13KB
|
411 lines
{*****************************************************************************
** Communications Server Version 1.0 May 1, 1991 **
** Copyright 1987,1988,1991 by L. Brett Glass, Systems Consultant **
******************************************************************************}
program Commserver;
{$M 8192,0,0} {Use 8K of stack, no heap}
uses NetBIOS,NetTools,DOS,CRT;
{BIOS list of UART base I/O addresses}
type
PortNumType = 1..4; {We restrict comm port numbers to 1 thru 4
because that's what's in the BIOS table}
var
biosPortTable : array[portNumType] of Word absolute $40:00;
{UART declarations}
{The following constants give the offsets of ports from
the UART's base address}
const
RBR = $0; {Receiver Buffer Register}
THR = $0; {Transmit Holding Register}
DLL = $0; {Low byte of divisor}
DLH = $1; {High byte of divisor}
IER = $1; {Interrupt Enable Register}
IIR = $2; {Interrupt Identification Register}
LCR = $3; {Line Control Register}
MCR = $4; {Modem Control Register}
LSR = $5; {Line Status Register}
{The following table lists baud rates. It maps the codes used
in the BIOS to divisors.}
const
divisorTable : array[0..8] of Word = (
{110} $417, {150} $300, {300} $180, {600} $0C0, {1200} $060,
{2400} $030, {4800} $018, {9600} $00C, {19200} $006);
{The following constants are necessary for managing interrupts}
const
OCW1 = $21; {Port address of enable bits for 8259}
OCW2 = $20; {Port address for commands to 8259}
NSEOI = $20; {Nonspecific EOI command}
{Bit to use to mask interrupts at 8259}
intMask : array [PortNumType] of Byte = ($10,$08,$10,$08);
{Vector numbers for ports}
commIntVec : array [PortNumType] of Byte = (12,11,12,11);
{The following masks are useful to manipulate bits
in the UART registers}
const
ERBFI = $01; {Mask to enable receive interrupts}
THRE = $20; {Mask for THRE}
DTR = $01; {Mask for DTR}
DLAB = $80; {Mask for DLAB}
RTS = $02; {Mask for RTS}
OUT2 = $08; {Mask for OUT2}
{The following constants are handy to intialize the UART}
const
ONESTOP = $00;{Mask for 1 stop bit}
NOPARITY = $00; {Mask for no parity}
EIGHTBITS = $03;{Mask for 8 bits/char}
{The following constant is returned in ah to indicate that no chars
are available during a read}
ERRORBYTE = $80;
{The following byte is used to mask the line status on a successful
read. Note that the uppermost bit isn't allowed through, since
a successful read does not set the timeout bit.}
READSTATUSMASK = $0F;
{The following byte is used to mask requests to change the serial
port parameters.}
CHARMASK = $1F;
{These constants determine the initial baud rate for the port,
the size of the receive buffer, and other serial port parameters}
const
INITIALBAUD = 4; {Start at 1200 baud when initializing}
BUFFMAX = 255; {Size of receive buffer -- should be 2^n - 1}
type
CommRegType = record
case Boolean of
TRUE: (dx,cx,bx,ax : Word);
FALSE: (dl,dh,cl,ch,bl,bh,al,ah : Byte);
end;
var
portName : NetName; {Network name of serial port}
portNameNum : Byte; {Number of this name in local name table}
portNum : PortNumType; {Serial port number}
portBase : Word; {Base address of UART}
rcvBuff : array [0..BUFFMAX] of Byte; {Circular fall-out buffer}
buffIn, buffOut : Integer; {Buffer head and tail pointers}
oldIntVec : Pointer; {Storage for old interrupt vector}
commSessionNum : Byte; {Number of NetBIOS session}
clientName : NetName; {Name of client}
function HexStr(var num; byteCount : Byte) : String;
const
hexChars : array [0..$F] of Char = '0123456789ABCDEF';
var
numArray : array [Byte] of Byte absolute num; {Access bytes of num}
tempStr : String; {Holds result}
tempLen : Byte absolute tempStr; {Length of result}
begin
tempLen := 0;
for byteCount := Pred(byteCount) downto 0 do {numArray is 0-based}
tempStr := tempStr + {Add: }
hexChars[numArray[byteCount] shr 4] + {Hi digit}
hexChars[numArray[byteCount] and $F]; {Lo digit}
HexStr := tempStr
end; {HexStr}
procedure ValidateParms;
var
tempStr : String;
begin
if ParamCount <> 2 then
begin
Writeln('Usage: COMMSERVER <Network Name> <Port Number>');
Writeln(' E.G.: COMMSERVER MyModem 2');
Writeln(' Makes COM2: a networked communications port');
Writeln(' with the name MyModem');
Halt
end;
tempStr := ParamStr(1);
if (Length(tempStr) = 0) or (Length(tempStr) > 16) then
begin
Writeln('Error: Serial port/modem name must be 1 to 16 characters');
Halt
end;
FillChar(portName,SizeOf(portName),' ');
Move(tempStr[1],portName[1],Length(tempStr));
tempStr := ParamStr(2);
if (Length(tempStr) <> 1) or (tempStr[1] < '1') or
(tempStr[1] > '4') then
begin
Writeln('Error: Port number must be 1 through 4');
Halt
end;
portNum := Ord(tempStr[1])-Ord('0');
portBase := biosPortTable[portNum];
if portBase = 0 then
begin
Writeln('Error: Port does not exist');
Halt
end;
end; {ValidateParms}
procedure IntHandler; interrupt; {Received character ISR}
begin
asm sti end;
buffIn := Succ(buffIn) and BUFFMAX;
rcvBuff[buffIn] := Port[portBase+RBR];
if buffIn = buffOut then {Queue is overflowing. Keep newest characters.}
buffOut := Succ(buffOut) and BUFFMAX;
Port[OCW2] := NSEOI
end; {IntHandler}
procedure InitPort;
begin
buffIn := 0;
buffOut := 0;
Port[portBase+IER] := 0; {Disable comm interrupts first}
{Hook into the interrupt vector}
GetIntVec(commIntVec[portNum],oldIntVec);
SetIntVec(commIntVec[portNum],Addr(IntHandler));
{Initialize the UART}
Port[portBase+LCR] := Port[portBase+LCR] or DLAB; {Access divisor latch}
Port[portBase+DLL] := Lo(divisorTable[INITIALBAUD]); {Set baud rate to 1200 }
Port[portBase+DLH] := Hi(divisorTable[INITIALBAUD]);
Port[portBase+LCR] := EIGHTBITS or ONESTOP or NOPARITY; {Clear DLAB and set parms}
Port[portBase+MCR] := DTR or RTS or OUT2; {Enable interrupts, turn on DTR & RTS}
{Turn on interrupts at the 8259}
Port[OCW1] := Port[OCW1] and not(intMask[portNum]);
if Port[portBase+LSR] <> 0 then; {Clear errors}
if Port[portBase+RBR] <> 0 then; {Rmove any trash in RBR}
Port[portBase+IER] := ERBFI; {Enable UART receive interrupts}
end; {InitPort}
procedure Shutdown;
begin
Port[portBase+IER] := 0; {Kill UART interrupts}
Port[portBase+OCW1] := Port[portBase+ OCW1]
or intMask[portNum]; {Mask interrupts at PIC}
Port[portBase+MCR] := 0; {Shut off DTR, RTS, OUT2}
SetIntVec(commIntVec[portNum],oldIntVec);
if NetToolsDeleteName(portName) <> GOOD_RTN then; {Only try once}
Writeln('Communcations server shutting down....');
Halt;
end; {Shutdown}
function UserAbort : Boolean;
begin
UserAbort := FALSE;
if KeyPressed then
case ReadKey of
#3 : UserAbort := TRUE;
#0 : if KeyPressed then
UserAbort := (ReadKey = #0)
end;
end; {UserAbort}
procedure AwaitClient;
var
listenBlock : NCB;
procedure ListenError;
begin
Writeln('Error: NetBIOS error when listening for clients');
Shutdown
end; {ListenError}
begin
case NetToolsStartListen(listenBlock,wildName,portName,10,10) of
GOOD_RTN,COMMAND_PENDING:;
else
ListenError
end;
while TRUE do
begin
if UserAbort then
begin
NetToolsAbortListen(listenBlock);
Shutdown
end;
case NetToolsCheckListen(listenBlock,commSessionNum,clientName) of
GOOD_RTN : Exit;
COMMAND_PENDING:;
else
ListenError
end
end;
end; {AwaitClient}
function CharAvail : Boolean;
begin
asm cli end;
CharAvail := (buffIn <> buffOut); {Do test with interrupts off}
asm sti end;
end; {CharAvail}
procedure HandleRequest(var commRegs : CommRegType);
begin
with commRegs do
begin
case ah of
0: {Initialize comm port}
begin
Port[portBase+LCR] := Port[portBase+LCR] or DLAB; {Access divisor latch}
Port[portBase+DLL] := Lo(divisorTable[ah shr 5]); {Set baud rate}
Port[portBase+DLH] := Hi(divisorTable[ah shr 5]);
Port[portBase+LCR] := al and CHARMASK; {Set character parameters}
ah := Port[portBase+LSR] or Byte(CharAvail);
al := Port[portBase+MCR]; {Return modem status}
end;
1: {Send character}
begin
{Because the UART always runs, we wait at most one character time}
repeat until (Port[portBase+LSR] and THRE) <> 0;
Port[portBase+THR] := al;
ah := Port[portBase+LSR] or Byte(CharAvail);
end;
2: {Receive character}
begin
if CharAvail then
begin
asm cli end; {Maintain consistency}
buffOut := Succ(buffOut) and BUFFMAX;
al := rcvBuff[buffOut];
asm sti end; {Interrupts OK now}
ah := (Port[portBase+LSR] or Byte(CharAvail)) and READSTATUSMASK;
end
else
ah := ERRORBYTE;
end;
3: {Get Status}
begin
ah := Port[portBase+LSR] or Byte(CharAvail);
al := Port[portBase+MCR]; {Return modem status}
end;
4: {Extended Initialize}
begin
if cl <= 8 then
begin
Port[portBase+LCR] := Port[portBase+LCR] or DLAB; {Access divisor latch}
Port[portBase+DLL] := Lo(divisorTable[cl]); {Set baud rate}
Port[portBase+DLH] := Hi(divisorTable[cl]);
end;
Port[portBase+LCR] := ((al and 1) shr 6) {Break}
+ ((bh and 3) shr 3) {Parity}
+ ((bl and 1) shr 2) {Stop bits}
+ ((ch + 1) and 3); {Data bits)
ah := Port[portBase+LSR] or Byte(CharAvail);
al := Port[portBase+MCR]; {Return modem status}
end;
5: {Modem Control}
begin
if al = 1 then
begin
Port[portBase+MCR] := bl;
ah := Port[portBase+LSR] or Byte(CharAvail);
al := Port[portBase+MCR]; {Return modem status}
end
else
bl := Port[portBase+MCR];
end;
end; {case}
end; {with}
end; {HandleRequest}
procedure FieldRequests;
var
serverRcvBlock, serverSendBlock : NCB;
commRegs : CommRegType;
begin
serverRcvBlock.Init(RECEIVE);
serverSendBlock.Init(SEND);
while TRUE do
begin
with serverRcvBlock do
begin
len := SizeOf(commRegs);
bufPtr := Addr(commRegs);
lsn := commSessionNum;
case serverRcvBlock.ReturnCode of
TIMEOUT: if UserAbort then
begin
if NetToolsHangup(commSessionNum) <> GOOD_RTN then;
Shutdown
end;
ILL_SESSION,SESSION_ABEND: {These mean session over}
begin
Writeln('Session aborted');
Exit;
end;
SESSION_CLOSED:
begin
Writeln('Client closed session');
Exit;
end;
GOOD_RTN:
begin
if len <> SizeOf(commRegs) then {Kill session if bad packet}
begin
if NetToolsHangup(commSessionNum) <> GOOD_RTN then;
Exit
end;
HandleRequest(commRegs);
with serverSendBlock do
begin
bufPtr := Addr(commRegs);
len := SizeOf(commRegs);
lsn := commSessionNum;
if ReturnCode <> GOOD_RTN then
Exit; {Session dead if send didn't complete}
end
end
end {case}
end {with}
end {while}
end; {FieldRequests}
begin {CommServer}
CheckBreak := FALSE;
DirectVideo := TRUE;
Writeln('CommServer V1.00, Copyright 1991 by L. Brett Glass');
ValidateParms;
if not NetBIOSPresent then
begin
Writeln('Error: NetBIOS not present');
Halt
end;
if NetToolsAddUniqueName(portName,portNameNum) <> GOOD_RTN then
begin
Writeln('Error: Could not register port name');
Halt
end;
InitPort;
while TRUE do
begin
Writeln('Awaiting a client...');
AwaitClient;
Writeln('Connection established with client ', HexStr(clientName,16));
FieldRequests;
Writeln('End of session');
end;
end.