Category : Pascal Source Code
Archive   : GSCOMM.ZIP
Filename : GSCOMM.PAS

{$R-,S-,V-,B-,F+}
UNIT GSCOMM;
{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ GSCOMM - Interupt Driven Async Library for Turbo Pascal ³
³ By Guy Smith & The Phoenix Software Group ³
³ ³
³ INTRODUCTION: ³
³ ³
³ GSCOMM is a library for asynchronious communications using Turbo ³
³ Pascal. The files in this archive will work with both versions ³
³ 4.0 and up of Borland's Turbo Pascal. The library will allow ³
³ you to control interupt driven communications using up to eight (8) ³
³ concurently open ports. The library has not been tested using any ³
³ of the "smart" I/O boards such as Digiboard's COM8 board, but it ³
³ has been tested using the standard serial I/O ports. A complete ³
³ listing and reference of each function follows. ³
³ ³
³ HISTORY & TECH INFO: ³
³ ³
³ GSCOMM is written compleatly in Turbo Pascal and makes no use of any ³
³ assembler routines. This is the initial release of the library and ³
³ depending on the responce received from you the users, there may be ³
³ additional releases. The library was developed to replace another ³
³ library that I was using - JBCOMM by Jim Burg - when it was found ³
³ to cause problems with certian 286 & 386 motherboards. GSCOMM is ³
³ the hart and sole of the communications routines used by the FORCE! ³
³ bbs package (Also from Guy Smith & The Phoenix Software Group). ³
³ ³
³ WARRANTY & DISCLAIMER: ³
³ ³
³ You are free to use and distribute GSCOMM to others as long as you ³
³ do not charge a fee (other than the cost of the media). GSCOMM is ³
³ distributed as SHAREWARE and registration is required if you wish ³
³ to continue to use the produce after a resonable evaluation period. ³
³ If after the evaluation period you find that you are pleased with ³
³ the software, but don't believe in registering shareware, may the ³
³ spirit of disk crashes haunt you for eternity! (hee,hee) If you ³
³ chose to use the routines in any commercial product, I only ask that ³
³ you let me know so that I might brag about it! Guy Smith & The ³
³ Phoenix Software Group takes no responsibility for any damage or loss³
³ due to the use of this library. ³
³ ³
³ REGISTRATION: ³
³ ³
³ You may register this product by sending a check or money order ³
³ payable to Guy Smith to: ³
³ ³
³ The Phoenix Software Group ³
³ 1306 Heights pl ³
³ Vineland, NJ 08360 ³
³ ³
³ You may contact me on my BBS at: (609)696-1346 - 2400bd ³
³ ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}

INTERFACE

TYPE
ComStr = String;
PortType = (com0, com1, com2, com3, com4, com5, com6, com7, com8);
Parityt = (p_none,p_even,p_odd,p_even_stick,p_odd_stick);

Procedure C_Set_Speed (cp : porttype;
speed : Longint);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_Set_Speed ³
³ ³
³ PARAMETERS : cp = Com port to change baud rate of. (COM1..COM8) ³
³ speed = New baud rate for com port. (2..65535) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Allows the re-setting of the baud rate in an ACTIVE com ³
³ port. The port MUST be open for this function to work ³
³ properly! ³
³ ³
³ USAGE : C_SET_SPEED(COM1,9600); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_Lock_Speed (cp : porttype;
speed : Longint);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_Lock_Speed ³
³ ³
³ PARAMETERS : cp = Com port to lock baud rate of. (COM1..COM8) ³
³ speed = Baud rate to lock port at. (2..65535) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Allows the locking of the baud rate in an ACTIVE com ³
³ port. The port MUST be open for this function to work ³
³ properly! ³
³ ³
³ USAGE : C_LOCK_SPEED(COM1,9600); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_Lync_Ports (cp1,
cp2 : porttype;
Toggle : boolean);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_Lync_Ports ³
³ ³
³ PARAMETERS : cp1 = Com port #1 to link to #2. (COM1..COM8) ³
³ cp2 = Com Port #2 to link to #1. (COM1..COM8) ³
³ toggle = Create link (true) or Break link (false) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Allows the linking of I/O from 1 port to another and ³
³ back. The ports MUST be open for this function to work ³
³ properly! ³
³ ³
³ USAGE : C_LYNC_PORTS(COM1,COM2); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_Open (cp : porttype;
speed : Longint;
parity : parityt;
data,
stops : byte;
ibuffs,
obuffs : word);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_Open ³
³ ³
³ PARAMETERS : cp = Com port to open for use. (COM1..COM8) ³
³ speed = Baud rate to open port at. (2..65535) ³
³ parity = parity to open port at. (SEE PARITYT TYPE) ³
³ data = Number of data bits for port. (7 or 8) ³
³ stops = Number of stop bits for port. (Usualy 1) ³
³ ibuffs = Size in bytes of input buffer. (2..10000) ³
³ obuffs = Size in bytes of output buffer. (2..10000) ³
³ ³
³ ³
³ CALLS : C_Set_Speed ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Opens a com port using the passed parameters for serial ³
³ comunications. The port MUST NOT be currently open! ³
³ This procedure will save the original setting of the ³
³ interupt controler and the modem control register, these ³
³ settings will be will be restored when the port is closed. ³
³ ³
³ USAGE : C_OPEN(COM1,9600,P_NONE,8,1,1024,1024); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_Close (cp : porttype;
dropdtr : boolean);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_Close ³
³ ³
³ PARAMETERS : cp = Com port to close down. (COM1..COM8) ³
³ dropDTR = Setting of DTR of closed port. (TRUE,FALSE) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Closes a com port and restors the interupt controler and ³
³ modem control register to there original settings except ³
³ for DTR, this will be set according to the passed parameter.³
³ This function MUST be called for all ACTIVE ports before ³
³ terminating the program!! ³
³ ³
³ USAGE : C_CLOSE(COM1,TRUE); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_Close_All (dropdtr : boolean);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_Close ³
³ ³
³ PARAMETERS : dropDTR = Setting of DTR of closed port. (TRUE,FALSE) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Closes all com ports and restors the interupt controler and ³
³ modem control register to there original settings except ³
³ for DTR, this will be set according to the passed parameter.³
³ This function MUST be called for all ACTIVE ports before ³
³ terminating the program!! ³
³ ³
³ USAGE : C_CLOSE_ALL(TRUE); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_PutC (cp : porttype;
ch : char);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_PutC ³
³ ³
³ PARAMETERS : cp = Com port to send character to. (COM1..COM8) ³
³ ch = character to place in output buffer ³
³ for transmission. ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Places a character in the selected ports output buffer. ³
³ The character will be transmitted by the interupt handler ³
³ when the receiving port is ready. ³
³ ³
³ USAGE : C_PUTC(COM1,'A'); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_PutCNB (cp : porttype;
ch : char);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_PutCNB ³
³ ³
³ PARAMETERS : cp = Com port to send character to. (COM1..COM8) ³
³ ch = character to send directly to port. ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Sends a character to the selected port without using the ³
³ output buffer. This is usefull when sending characters to ³
³ initialize the port (AT commands). ³
³ ³
³ USAGE : C_PUTCNB(COM1,'A'); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_PutS (cp : porttype;
outstr : comstr;
ChrDelay : longint);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_PutS ³
³ ³
³ PARAMETERS : cp = Com port to send string to. (COM1..COM8)³
³ outstr = String to place in output buffer ³
³ for transmission. ³
³ chardelay = Delay in milliseconds to pause between ³
³ each character. ³
³ ³
³ CALLS : C_PutC ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Places a string in the selected ports output buffer. ³
³ The characters will be transmitted by the interupt handler ³
³ when the receiving port is ready. ³
³ ³
³ USAGE : C_PUTS(COM1,'Press any key to continue',0); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_PutSNB (cp : porttype;
outstr : comstr;
ChrDelay : longint);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_PutSNB ³
³ ³
³ PARAMETERS : cp = Com port to send string to. (COM1..COM8) ³
³ outstr = String to send directly to port. ³
³ chardelay = Delay in milliseconds to pause between ³
³ each character. ³
³ ³
³ CALLS : C_PutCNB ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Sends a string to the selected port without using the ³
³ output buffer. This is usefull when sending characters to ³
³ initialize the port (AT commands). Placing a ~ in the ³
³ string will cause a 1/4 second delay and not transmit the ³
³ character. A | will be interpreted as a CR/LF and will ³
³ also not transmit the character. ³
³ ³
³ USAGE : C_PUTSNB(COM1,'~~ATZ~~|',5); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_Flush_In (cp : porttype);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_Flush_In ³
³ ³
³ PARAMETERS : cp = Com port whose buffer to clear. (COM1..COM8) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Flushes (clears) the selected port's input buffer. All ³
³ characters in the buffer will be lost. ³
³ ³
³ USAGE : C_FLUSH_IN(COM1); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_Flush_Out (cp : porttype);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_Flush_Out ³
³ ³
³ PARAMETERS : cp = Com port whose buffer to clear. (COM1..COM8) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Flushes (clears) the selected port's output buffer. All ³
³ characters will be removed from the buffer. ³
³ ³
³ USAGE : C_FLUSH_OUT(COM1); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Procedure C_Port_Data (cp : porttype;
offset : word;
irql : byte);
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ PROCEDURE : C_Port_Data ³
³ ³
³ PARAMETERS : cp = Com port whose address to change. (COM1..COM8) ³
³ offset = New offset address for port. ³
³ irql = New IRQ level for port. ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Nothing ³
³ ³
³ PURPOSE : Changes the address and IRQ level of the selected port. ³
³ Use of ports above COM4 will require this procedure be ³
³ called before opening the port. This procedure may only ³
³ be used on an INACTIVE port! ³
³ ³
³ USAGE : C_Port_Data(COM1,$03F8,4); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Function C_InReady (cp : porttype) : word;
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ FUNCTION : C_InReady ³
³ ³
³ PARAMETERS : cp = Com port whose buffer to check. (COM1..COM8) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Number of characters currently waiting in the input buffer. ³
³ ³
³ PURPOSE : Checks the selected port's input buffer and returns the ³
³ number of characters currently waiting to be processed. ³
³ ³
³ USAGE : repeat ch:= C_GETC(COM1) until C_INREADY(COM1) = 0; ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Function C_OutReady (cp : porttype) : word;
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ FUNCTION : C_OutReady ³
³ ³
³ PARAMETERS : cp = Com port whose buffer to check. (COM1..COM8) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Number of characters currently waiting in the output buffer.³
³ ³
³ PURPOSE : Checks the selected port's output buffer and returns the ³
³ number of characters currently waiting to be processed. ³
³ ³
³ USAGE : repeat until C_OUTREADY(COM1) = 0; ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Function C_GetC (cp : porttype) : char;
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ FUNCTION : C_GetC ³
³ ³
³ PARAMETERS : cp = Com port to get character from. (COM1..COM8) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : Character from input buffer of #0 if buffer is empty. ³
³ ³
³ PURPOSE : Gets the next available character (if any) from the ³
³ selected com port. ³
³ ³
³ USAGE : ch:=C_GETC(COM1); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Function C_Carrier (cp : porttype) : boolean;
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ FUNCTION : C_Carrier ³
³ ³
³ PARAMETERS : cp = Com port to check for carrier. (COM1..COM8) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : TRUE if carrier is present or FALSE if no carrier. ³
³ ³
³ PURPOSE : Checks the selected port for carrier detect. ³
³ ³
³ USAGE : if not C_CARRIER(COM1) then halt; ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

Function C_CTS (cp : porttype) : boolean;
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ FUNCTION : C_CTS ³
³ ³
³ PARAMETERS : cp = Com port to check for CTS high. (COM1..COM8) ³
³ ³
³ CALLS : None ³
³ ³
³ RETURNS : TRUE if CTS (clear to send) is HIGH else FLASE. ³
³ ³
³ PURPOSE : Checks the selected port to see if CTS is high. ³
³ ³
³ USAGE : repeat until C_CTS(COM1); ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

function C_Tget_Stream(cp : porttype;
var getbuf : string;
n,
timeout : LONGINT) : LONGINT;
{ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ FUNCTION : C_Tget_Stream ³
³ ³
³ PARAMETERS : cp = Com port to get string from. (COM1..COM8) ³ ³
³ getbuf = string to return stream in. ³
³ n = number of characters to get. ³
³ timeout = number of milliseconds to wait for characters. ³
³ ³
³ CALLS : C_GetC ³
³ ³
³ RETURNS : Number of characters received from buffer. ³
³ ³
³ PURPOSE : Gets N number of characters from the input buffer. This ³
³ function will wait (TIMEOUT * 20) number of milliseconds ³
³ for the desired number of characters before returning. The ³
³ characters will be returned in a string (getbuf). ³
³ ³
³ USAGE : if C_Tget_Stream(COM1,instring,20,1000) < 20 then halt; ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}

IMPLEMENTATION

Uses DOS, CRT;

Type
BufferArray = Array [1..1] of char;

ComRec = Record
Open,
Locked : boolean;
BaseAddr : word;
BaseIrq,
Old_LCR,
Old_ICTL,
Old_IER,
Old_MCR : byte;
Old_i8259_mask: Byte;
i8259bit : Byte;
OldInt : pointer;
InSize,
OutSize,
InHead,
InTail,
CharInBuff,
OutHead,
OutTail,
CharOutBuff : integer;
LockedBaud : Longint;
LinkedPort : porttype;
InBuffer,
OutBuffer : ^BufferArray;
End;

Var
ComPort : Array [COM1..COM8] of ComRec;
Z : PortType;
CM,DM : BYTE;
Uart_Type : BYTE;

CONST

C_MinBaud = 50;

C_MaxBaud = 115200;

ICTL = $21; (* system interrupt controller i/o port *)

RBR = 0; (* receive buffer register *)
THR = 0; (* transmit holding register *)

DLM = 1; (* divisor latch MSB *)
IER = 1; (* interrupt enable register *)
IER_DAV = $01; (* data available interrupt *)
IER_THRE = $02; (* THR empty interrupt *)
IER_LSRC = $04; (* line status change interrupt *)
IER_MSR = $08; (* modem status interrupt *)

IIR = 2; (* interrupt identification register *)
IIR_PENDING = $01; (* low when interrupt pending *)

IIR_MASK = $06; (* mask for interrupt identification *)
IIR_MSR = $00; (* modem status change interrupt *)
IIR_THRE = $02; (* transmit holding reg empty interrupt *)
IIR_DAV = $04; (* data available interrupt *)
IIR_LSR = $06; (* line status change interrupt *)

FCR = 2; (* FIFO control register *)
FCR_ENABLE_FIFO = $C1; (* write to port to enable FIFO *)
FCR_DISABLE_FIFO = $00; (* write to port to disable FIFO *)
FCR_16550 = $80; (* bit set if chip is 16550 or 16550AN *)

LCR = 3; (* line control register *)
LCR_5BITS = $00; (* 5 data bits *)
LCR_7BITS = $02; (* 7 data bits *)
LCR_8BITS = $03; (* 8 data bits *)

LCR_1STOP = $00; (* 1 stop bit *)
LCR_2STOP = $04; (* 2 stop bits *)

LCR_NPARITY = $00; (* no parity *)
LCR_EPARITY = $38; (* even parity *)

LCR_NOBREAK = $00; (* break disabled *)
LCR_BREAK = $40; (* break enabled *)

{LCR_NORMAL = $00;} (* normal *)
LCR_ABDL = $80; (* address baud divisor latch *)

MCR = 4; (* modem control register *)
MCR_DTR = $01; (* active DTR *)
MCR_RTS = $02; (* active RTS *)
MCR_OUT1 = $04; (* enable OUT1 *)
MCR_OUT2 = $08; (* enable OUT2 -- COM INTERRUPT ENABLE *)
MCR_LOOP = $10; (* loopback mode *)

LSR = 5; (* line status register *)
LSR_DAV = $01; (* data available *)
LSR_OERR = $02; (* overrun error *)
LSR_PERR = $04; (* parity error *)
LSR_FERR = $08; (* framing error *)
LSR_BREAK = $10; (* break received *)
LSR_THRE = $20; (* THR empty *)
LSR_TSRE = $40; (* transmit shift register empty *)

LOERR_count: integer = 0; {overrun error count}
LPERR_count: integer = 0; {parity error count}
LFERR_count: integer = 0; {framing error count}
LBREAK_count: integer = 0; {break received count}

MSR = 6; (* modem status register *)
MSR_DCTS = $01; (* delta CTS *)
MSR_DDSR = $02; (* delta DSR *)
MSR_DRING = $04; (* delta ring *)
MSR_DRLSD = $08; (* delta receive line signal detect *)
MSR_CTS = $10; (* clear to send *)
MSR_DSR = $20; (* data set ready *)
MSR_RING = $40; (* ring detect *)
MSR_RLSD = $80; (* receive line signal detect *)

PROCEDURE IO_Delay; INLINE($EB/$00);

Function C_CTS (cp : porttype) : boolean;
begin
C_CTS:=Odd(Port[ComPort[CP].BaseAddr+MSR_CTS]);
end;

Procedure C_PutC (cp : porttype;
ch : char);
begin
Repeat Until (ComPort[CP].CharOutBuff < ComPort[CP].OutSize) and
((NOT ComPort[CP].Locked) or (C_CTS(CP)));
Inline($FA);
ComPort[CP].OutBuffer^[ComPort[CP].OutHead]:=CH;
if ComPort[CP].OutHead < ComPort[CP].OutSize then
INC(ComPort[CP].OutHead)
else
ComPort[CP].OutHead:=1;
INC(ComPort[CP].CharOutBuff);
Port[ComPort[CP].BaseAddr + IER]:= Port[ComPort[CP].BaseAddr + IER] OR 2;
Inline($FB);
end;

Function C_GetC (cp : porttype) : char;
begin
if (ComPort[CP].CharInBuff > 0) then
begin
Inline($FA);
C_GetC:=ComPort[CP].InBuffer^[ComPort[CP].InTail];
if ComPort[CP].InTail < ComPort[CP].InSize then
INC(ComPort[CP].InTail)
else
ComPort[CP].InTail:=1;
DEC(ComPort[CP].CharInBuff);
InLine($FB);
end
else C_GetC:=#0;
end;

procedure AsyncSend(Z : PortType);
begin
if ODD(Port[ComPort[Z].BaseAddr + LSR_THRE]) then
begin
if (ComPort[Z].CharOutBuff > 0) then
begin
Port[ComPort[Z].BaseAddr+THR]:=
Ord(ComPort[Z].OutBuffer^[ComPort[Z].OutTail]);
if ComPort[Z].OutTail < ComPort[Z].OutSize then
INC(ComPort[Z].OutTail)
else
ComPort[Z].OutTail:=1;
DEC(ComPort[Z].CharOutBuff);
end;
end;
end;

procedure AsyncRecv(Z : PortType);
var ch : char;
begin
if (ComPort[Z].CharInBuff < ComPort[Z].InSize) then
begin
ComPort[Z].InBuffer^[ComPort[Z].InHead]:=
Chr(Port[ComPort[Z].BaseAddr+RBR]);
if ComPort[Z].InHead < ComPort[Z].InSize then
INC(ComPort[Z].InHead)
else
ComPort[Z].InHead:=1;
INC(ComPort[Z].CharInBuff);
if ComPort[Z].LinkedPort <> COM0 then
begin
C_PutC(ComPort[Z].LinkedPort,C_GetC(Z));
end;
end;
end;

procedure AsyncInt(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: word); Interrupt;
begin
for Z:=COM1 to COM8 do
begin
if ComPort[Z].Open then
begin
CM:=Port[ComPort[Z].BaseAddr + IIR]; IO_Delay;
While (CM and IIR_PENDING) = 0 do
begin
Case (CM and IIR_MASK) of
IIR_DAV : AsyncRecv(Z);
IIR_THRE : AsyncSend(Z);
IIR_MSR : DM:=Port[ComPort[Z].BaseAddr + MSR];
IIR_LSR : DM:=Port[ComPort[Z].BaseAddr + LSR];
end;
CM:=Port[ComPort[Z].BaseAddr + IIR]; IO_Delay;
end;
Port[$20]:=$20; IO_Delay;
end;
end;
end;

Procedure C_Flush_In (cp : porttype);
begin
Inline($FA);
ComPort[CP].CharInBuff:=0;
ComPort[CP].InHead:=1;
ComPort[CP].InTail:=1;
Fillchar(ComPort[CP].InBuffer^,ComPort[CP].InSize,0);
Inline($FB);
end;

Procedure C_Flush_Out (cp : porttype);
begin
Inline($FA);
ComPort[CP].CharOutBuff:=0;
ComPort[CP].OutHead:=1;
ComPort[CP].OutTail:=1;
Fillchar(ComPort[CP].OutBuffer^,ComPort[CP].OutSize,0);
Inline($FB);
end;

PROCEDURE C_Raise_DTR(cp : PortType);
VAR P : Word;
BEGIN
P := ComPort[CP].BaseAddr;
PORT[ P+MCR ] := PORT [ P+MCR ] or (MCR_DTR+MCR_RTS);
IO_Delay;
END;

PROCEDURE C_Lower_DTR(cp : PortType);
VAR P : Word;
BEGIN
P := ComPort[CP].BaseAddr;
PORT[ P+MCR ] := PORT [ P+MCR ] and NOT MCR_DTR;
IO_Delay;
END;

Procedure C_Set_Speed (cp : porttype;
speed : Longint);
Var
X,Y,P : Longint;
DivMSB,
DivLSB : Byte;
begin
if ComPort[cp].Locked then
X := ComPort[cp].LockedBaud
else
X := Speed;
If X < C_MinBaud Then X := C_MinBaud;
If X > C_MaxBaud Then X := C_MaxBaud;
Y := Round($900/(X/50));
DivMSB := Hi(Y);
DivLSB := Lo(Y);
P := ComPort[cp].BaseAddr;
Inline($FA);
Port[P+LCR]:= Port[P+LCR] OR $80;
Port[P] := DivLSB;
Port[P+1] := DivMSB;
Port[P+LCR]:= Port[P+LCR] AND NOT $80;
Inline($FB);
end;

Procedure C_Lock_Speed (cp : porttype;
speed : Longint);
begin
ComPort[cp].LockedBaud:=speed;
ComPort[cp].Locked:=true;
end;

Procedure C_Lync_Ports (cp1,
cp2 : porttype;
Toggle : boolean);
begin
case toggle of
true : begin
ComPort[cp1].LinkedPort:=cp2;
ComPort[cp2].LinkedPort:=cp1;
end;
false : begin
ComPort[cp1].LinkedPort:=COM0;
ComPort[cp2].LinkedPort:=COM0;
end;
end;
end;

Procedure C_Open (cp : porttype;
speed : Longint;
parity : parityt;
data,
stops : byte;
ibuffs,
obuffs : word);
Var
P : Word;
B : byte;
WS,SB,PTY : Byte;
begin
P := ComPort[CP].BaseAddr;

ComPort[CP].InSize:= IBuffS;
ComPort[CP].OutSize:= OBuffS;
GetMem(ComPort[CP].InBuffer,IBuffS);
GetMem(ComPort[CP].OutBuffer,OBuffS);
ComPort[CP].Open:= True;
C_Flush_In(cp);
C_Flush_Out(cp);
C_Raise_DTR(cp);

GetIntVec(8+ComPort[CP].BaseIRQ,ComPort[CP].OldInt);
SetIntVec(8+ComPort[CP].BaseIRQ,@AsyncInt);

Inline($FA);
ComPort[CP].Old_LCR := PORT[ P+LCR ]; io_delay;
ComPort[CP].Old_MCR := PORT[ P+MCR ]; io_delay;
ComPort[CP].Old_IER := PORT[ P+IER ]; io_delay;
ComPort[CP].Old_ICTL := PORT[ ICTL ]; io_delay;

PORT[ P+FCR ] := FCR_ENABLE_FIFO; io_delay;
Uart_Type := PORT[ P+FCR ]; io_delay;

PORT[ P+LCR ] := ComPort[CP].Old_LCR and not LCR_ABDL;
io_delay;

PORT[ P+MCR ] := PORT[ P+MCR ] or MCR_OUT2; io_delay;
PORT[ P+IER ] := IER_DAV+IER_THRE; io_delay;

ComPort[CP].i8259bit:= 1 SHL ComPort[CP].BaseIRQ;
ComPort[CP].Old_i8259_mask:= PORT[ ICTL ];
PORT[ ICTL ]:= ComPort[CP].Old_i8259_mask OR ComPort[CP].i8259bit;
io_delay;
Inline($FB);

Inline($FA);
C_Flush_In(cp);
Inline($FB);

C_Set_Speed(cp,speed);

Case Parity Of
P_None : PTY := $00 OR $03;
P_Even : PTY := $18 OR $02;
P_Odd : PTY := $08 OR $02;
Else PTY := $00 OR $03;
End;
IF stops = 2 THEN
PTY := PTY OR $04;
Inline($FA);
Port[P+LCR]:= Port[P+LCR] AND $40 OR PTY;
Inline($FB);
end;

Procedure C_Close (cp : porttype;
dropdtr : boolean);
var P, X : integer;
begin
if ComPort[CP].Open then
begin
P := ComPort[CP].BaseAddr;
if DropDTR then
ComPort[CP].Old_MCR:=ComPort[CP].Old_MCR AND NOT 1
else
ComPort[CP].Old_MCR:=ComPort[CP].Old_MCR OR 1;

Inline($FA);
SetIntVec(8+ComPort[CP].BaseIRQ,ComPort[CP].OldInt);
FreeMem(ComPort[CP].InBuffer,ComPort[CP].InSize);
FreeMem(ComPort[CP].OutBuffer,ComPort[CP].OutSize);
ComPort[CP].Open:=false;
Port[P+LCR] := ComPort[CP].Old_LCR;
Port[P+MCR] := ComPort[CP].Old_MCR;
Port[P+IER] := ComPort[CP].Old_IER;
Port[ ICTL ]:= Port[ ICTL ] AND NOT ComPort[CP].i8259bit OR
ComPort[CP].Old_i8259_mask AND ComPort[CP].i8259bit;
IO_Delay;
PORT[ P+FCR ] := FCR_DISABLE_FIFO; io_delay;
Inline($FB);
end;
end;

Procedure C_Close_All (dropdtr : boolean);
var P, X : integer;
CP : PortType;
begin
for CP:=COM1 to COM8 do C_Close(CP,dropdtr);
end;

Procedure C_PutCNB (cp : porttype;
ch : char);
begin
repeat until ODD(Port[ComPort[cp].BaseAddr + LSR_THRE]);
Inline($FA);
Port[ComPort[CP].BaseAddr+THR]:=Ord(CH);
Inline($FB);
end;

Procedure C_PutS (cp : porttype;
outstr : comstr;
ChrDelay : longint);
var X : byte;
begin
for X:=1 to Length(OutStr) do
begin
C_PutC(cp, OutStr[X]);
if ChrDelay > 0 then Delay(ChrDelay);
end;
end;

Procedure C_PutSNB (cp : porttype;
outstr : comstr;
ChrDelay : longint);
var X : byte;
begin
for X:=1 to Length(OutStr) do
begin
if OutStr[X] = '~' then Delay(250)
else
begin
if OutStr[X] = '|' then
begin
C_PutCNB(cp, #13);
C_PutCNB(cp, #10);
end
else C_PutCNB(cp, OutStr[X]);
if ChrDelay > 0 then Delay(ChrDelay);
end;
end;
end;

Procedure C_Port_Data (cp : porttype;
offset : word;
irql : byte);
begin
ComPort[CP].BaseAddr:=offset;
ComPort[CP].BaseIRQ:=irql;
end;

Function C_InReady (cp : porttype) : word;
begin
C_InReady:=Comport[CP].CharInBuff;
end;

Function C_OutReady (cp : porttype) : word;
begin
C_OutReady:=Comport[CP].CharOutBuff;
end;

Function C_Carrier (cp : porttype) : boolean;
begin
C_Carrier:=Odd(Port[ComPort[CP].BaseAddr+MSR_RLSD]);
end;

FUNCTION TimeOfDayH : LONGINT;
VAR
Hours : WORD;
Minutes : WORD;
Seconds : WORD;
SecHun : WORD;
TimerVal: LONGINT;

BEGIN (* TimeOfDayH *)
GetTime( Hours, Minutes, Seconds, SecHun );
TimerVal := Hours;
TimeOfDayH := TimerVal * 360000 + Minutes * 6000 + Seconds * 100 + SecHun;
END (* TimeOfDayH *);

FUNCTION TimeDiffH( Timer1, Timer2: LONGINT ) : LONGINT;
CONST Hundredths_Secs_Per_Day = 8640000 (* 1/100 Seconds in one day *);

VAR TDiff : LONGINT;

BEGIN (* TimeDiffH *)
TDiff := Timer2 - Timer1;
IF Tdiff < 0 THEN Tdiff := Tdiff + Hundredths_Secs_Per_Day;
TimeDiffH := Tdiff;
END (* TimeDiffH *);

FUNCTION C_TGet_Stream(cp : porttype;
var getbuf : string;
n,
timeout : LONGINT) : LONGINT;
VAR Ticker : longint;
CH : char;
LCounter : BYTE;
BEGIN
Ticker:=TimeOfDayH;
GetBuf:=''; LCounter:=0;
repeat
CH:=C_GetC(cp);
if CH = ^M then INC(LCounter);
if (CH <> #0) then GetBuf:=GetBuf + CH;
until ((Length(GetBuf) = N) or (LCounter = 2) or (TimeDiffH(Ticker,TimeOfDayH) > timeout));
C_TGet_Stream:=Length(GetBuf);
END;

BEGIN
ComPort[COM1].BaseAddr:=$03f8;
ComPort[COM1].BaseIRQ:=4;
ComPort[COM1].Open:=false;
ComPort[COM1].Locked:=false;
ComPort[COM1].LinkedPort:=COM0;
ComPort[COM2].BaseAddr:=$02f8;
ComPort[COM2].BaseIRQ:=3;
ComPort[COM2].Open:=false;
ComPort[COM2].Locked:=false;
ComPort[COM2].LinkedPort:=COM0;
ComPort[COM3].BaseAddr:=$03e8;
ComPort[COM3].BaseIRQ:=4;
ComPort[COM3].Open:=false;
ComPort[COM3].Locked:=false;
ComPort[COM3].LinkedPort:=COM0;
ComPort[COM4].BaseAddr:=$02e8;
ComPort[COM4].BaseIRQ:=3;
ComPort[COM4].Open:=false;
ComPort[COM4].Locked:=false;
ComPort[COM4].LinkedPort:=COM0;
for Z:=COM5 to COM8 do
begin
ComPort[Z].BaseAddr:=$03f8;
ComPort[Z].BaseIRQ:=4;
ComPort[Z].Open:=false;
ComPort[Z].Locked:=false;
ComPort[Z].LinkedPort:=COM0;
end;
END.