Чтобы иметь возможность работать с COM-портом как с потоком нужно немного расширить стандартный модуль CommV24, добавив в него процедуру NewStream в соответствии со спецификацией из CommStreams. Вот моя реализация:
Код:
MODULE CommV24;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems", Alexander Iljin
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = "
- 20061007, ai, ParseParams published. Fixed ParseParams handling last parameter.
- 20061007, ai, Deleted ASSERT(101) from procedure Available.
- 20060919, ai, Added support for virtual devices ("\\.\" prefix).
- 20060916, ai, Implemented non-blocking access via this module using CommStreams.Stream.
- 20060916, ai, Added inDTRon, inRTSon support.
- 20060916, ai, Some parameter restrictions enforced with ASSERTs. Added IsConnected.
- 20060916, ai, All active connections are closed upon module unload.
- 20060915, ai, SYSTEM module highlighted in bold.
- 20060915, ai, Output to StdLog deleted.
"
issues = ""
**)
IMPORT SYSTEM, WinApi, CommStreams, Strings;
CONST
bits4* = 0; bits5* = 1; bits6* = 2; bits7* = 3; stop15* = 4; stop2* = 5; even* = 6; odd* = 7; inXonXoff* = 8; outXonXoff* = 9; inRTS* = 10; inDTR* = 11; outCTS* = 12; outDSR* = 13; inDTRon* = 14; inRTSon* = 15;
TYPE
Connection* = POINTER TO LIMITED RECORD
hnd: WinApi.HANDLE; (* # 0: open *)
opts: SET
END;
Stream = POINTER TO LIMITED RECORD (CommStreams.Stream)
conn: Connection;
remoteAdr: CommStreams.Adr;
maxWrite: INTEGER
END;
ConnectionChain = POINTER TO RECORD
conn: Connection;
next: ConnectionChain
END;
VAR root: ConnectionChain;
PROCEDURE IsConnected (c: Connection): BOOLEAN;
BEGIN
ASSERT(c # NIL, 20);
RETURN c.hnd # 0
END IsConnected;
PROCEDURE Remove (c: Connection);
VAR cc, prev: ConnectionChain;
BEGIN
ASSERT(~IsConnected(c), 21); (* only closed connections should be removed from the chain *)
ASSERT(root # NIL, 100); (* if a connection was created, it should be in the list *)
IF c = root.conn THEN
root := root.next
ELSE
ASSERT(root.next # NIL, 100); (* if a connection was created, it should be in the list *)
prev := root;
cc := root.next;
WHILE (cc # NIL) & (cc.conn # c) DO
prev := cc;
cc := cc.next
END;
ASSERT((cc # NIL) & (cc.conn = c), 100); (* if a connection was created, it should be in the list *)
prev.next := cc.next
END
END Remove;
PROCEDURE Close* (c: Connection);
VAR res: INTEGER;
BEGIN
ASSERT(c # NIL, 20);
IF IsConnected(c) THEN
res := WinApi.CloseHandle(c.hnd);
ASSERT(res # 0, 100);
c.hnd := 0;
Remove(c)
END
END Close;
PROCEDURE Open* (device: ARRAY OF CHAR; baud: INTEGER; opts: SET; OUT conn: Connection);
VAR c: Connection; h: WinApi.HANDLE; res: INTEGER; dcb: WinApi.DCB; to: WinApi.COMMTIMEOUTS;
s: ARRAY WinApi.MAX_PATH OF CHAR;
cc: ConnectionChain;
BEGIN
conn := NIL; (* Alexander Iljin: this was not ensured *)
ASSERT(opts * {even, odd} # {even, odd}, 20);
IF bits4 IN opts THEN ASSERT(opts * {bits5, bits6, bits7} = {}, 21) END;
IF bits5 IN opts THEN ASSERT(opts * {bits4, bits6, bits7} = {}, 21) END;
IF bits6 IN opts THEN ASSERT(opts * {bits4, bits5, bits7} = {}, 21) END;
IF bits7 IN opts THEN ASSERT(opts * {bits4, bits5, bits6} = {}, 21) END;
ASSERT(opts * {inDTR, inDTRon} # {inDTR, inDTRon}, 22);
ASSERT(opts * {inRTS, inRTSon} # {inRTS, inRTSon}, 23);
IF device[0] # "\" THEN s := "\\.\" + device
ELSE s := device$
END;
h := WinApi.CreateFileW(
s, WinApi.GENERIC_READ + WinApi.GENERIC_WRITE,
{}, NIL, WinApi.OPEN_EXISTING, {}, 0
);
IF h # -1 THEN
dcb.DCBlength := SIZE(WinApi.DCB);
res := WinApi.GetCommState(h, dcb);
IF res # 0 THEN
dcb.BaudRate := baud;
dcb.fBits0 := {0}; (* binary *)
IF opts * {even, odd} # {} THEN INCL(dcb.fBits0, 1) END; (* check parity *)
IF outCTS IN opts THEN INCL(dcb.fBits0, 2) END; (* CTS out flow control *)
IF outDSR IN opts THEN INCL(dcb.fBits0, 3) END; (* DSR out flow control *)
IF inDTR IN opts THEN INCL(dcb.fBits0, 5) (* DTR flow control handshake *)
ELSIF inDTRon IN opts THEN INCL(dcb.fBits0, 4) (* DTR enable*)
END;
IF outXonXoff IN opts THEN INCL(dcb.fBits0, 8) END; (* Xon/Xoff out flow control *)
IF inXonXoff IN opts THEN INCL(dcb.fBits0, 9) END; (* Xob/Xoff in flow control *)
IF inRTS IN opts THEN INCL(dcb.fBits0, 13) (* RTS flow control handshake *)
ELSIF inRTSon IN opts THEN INCL(dcb.fBits0, 12) (* RTS enable*)
END;
IF bits4 IN opts THEN dcb.ByteSize := 4X
ELSIF bits5 IN opts THEN dcb.ByteSize := 5X
ELSIF bits6 IN opts THEN dcb.ByteSize := 6X
ELSIF bits7 IN opts THEN dcb.ByteSize := 7X
ELSE dcb.ByteSize := 8X
END;
IF stop15 IN opts THEN dcb.StopBits := 1X
ELSIF stop2 IN opts THEN dcb.StopBits := 2X
ELSE dcb.StopBits := 0X
END;
IF even IN opts THEN dcb.Parity := 2X
ELSIF odd IN opts THEN dcb.Parity := 1X
ELSE dcb.Parity := 0X
END;
res := WinApi.SetCommState(h, dcb);
IF res # 0 THEN
to.ReadIntervalTimeout := 0;
to.ReadTotalTimeoutMultiplier := 0;
to.ReadTotalTimeoutConstant := 0;
to.WriteTotalTimeoutMultiplier := 0;
to.WriteTotalTimeoutConstant := 0;
res := WinApi.SetCommTimeouts(h, to);
IF res # 0 THEN
NEW(c);
c.hnd := h;
c.opts := opts;
NEW(cc);
cc.conn := c;
cc.next := root;
root := cc;
conn := c
END
END
END
END
END Open;
PROCEDURE SendByte* (c: Connection; x: BYTE);
VAR res, written: INTEGER;
BEGIN
ASSERT(IsConnected(c), 21);
written := 0;
res := WinApi.WriteFile(c.hnd, SYSTEM.ADR(x), 1, written, NIL);
ASSERT(res # 0, 100);
ASSERT(written = 1, 101)
END SendByte;
PROCEDURE SendBytes* (c: Connection; IN x: ARRAY OF BYTE; beg, len: INTEGER);
VAR res, written: INTEGER;
BEGIN
ASSERT(IsConnected(c), 21);
ASSERT(LEN(x) >= beg + len, 22);
ASSERT(len > 0, 23);
written := 0;
res := WinApi.WriteFile(c.hnd, SYSTEM.ADR(x) + beg, len, written, NIL);
ASSERT(res # 0, 100);
ASSERT(written = len, 101)
END SendBytes;
PROCEDURE Available* (c: Connection): INTEGER;
VAR res: INTEGER; errors: SET; status: WinApi.COMSTAT;
BEGIN
ASSERT(IsConnected(c), 21);
errors := {};
status.cbInQue := 0;
res := WinApi.ClearCommError(c.hnd, errors, status);
ASSERT(res # 0, 100);
RETURN status.cbInQue
END Available;
PROCEDURE ReceiveByte* (c: Connection; OUT x: BYTE);
VAR res, read: INTEGER;
BEGIN
ASSERT(IsConnected(c), 21);
read := 0;
res := WinApi.ReadFile(c.hnd, SYSTEM.ADR(x), 1, read, NIL);
ASSERT(res # 0, 100);
ASSERT(read = 1, 101)
END ReceiveByte;
PROCEDURE ReceiveBytes* (c: Connection; OUT x: ARRAY OF BYTE; beg, len: INTEGER);
VAR res, read: INTEGER;
BEGIN
IF len = 0 THEN RETURN END;
ASSERT(IsConnected(c), 21);
ASSERT(LEN(x) >= beg + len, 22);
ASSERT(len > 0, 23);
read := 0;
res := WinApi.ReadFile(c.hnd, SYSTEM.ADR(x) + beg, len, read, NIL);
ASSERT(res # 0, 100);
ASSERT(read = len, 101)
END ReceiveBytes;
PROCEDURE SetBuffers* (c: Connection; inpBufSize, outBufSize: INTEGER);
VAR res: INTEGER;
BEGIN
ASSERT(IsConnected(c), 21);
res := WinApi.SetupComm(c.hnd, inpBufSize, outBufSize);
ASSERT(res # 0, 100)
END SetBuffers;
PROCEDURE SetDTR* (c: Connection; on: BOOLEAN);
VAR res: INTEGER;
BEGIN
ASSERT(IsConnected(c), 21);
ASSERT(~(inDTR IN c.opts), 22);
IF on THEN res := WinApi.EscapeCommFunction(c.hnd, WinApi.SETDTR)
ELSE res := WinApi.EscapeCommFunction(c.hnd, WinApi.CLRDTR)
END;
ASSERT(res # 0, 100)
END SetDTR;
PROCEDURE SetRTS* (c: Connection; on: BOOLEAN);
VAR res: INTEGER;
BEGIN
ASSERT(IsConnected(c), 21);
ASSERT(~(inRTS IN c.opts), 22);
IF on THEN res := WinApi.EscapeCommFunction(c.hnd, WinApi.SETRTS)
ELSE res := WinApi.EscapeCommFunction(c.hnd, WinApi.CLRRTS)
END;
ASSERT(res # 0, 100)
END SetRTS;
PROCEDURE SetBreak* (c: Connection; on: BOOLEAN);
VAR res: INTEGER;
BEGIN
ASSERT(IsConnected(c), 21);
IF on THEN res := WinApi.EscapeCommFunction(c.hnd, WinApi.SETBREAK)
ELSE res := WinApi.EscapeCommFunction(c.hnd, WinApi.CLRBREAK)
END;
ASSERT(res # 0, 100)
END SetBreak;
PROCEDURE CTSState* (c: Connection): BOOLEAN;
VAR res: INTEGER; s: SET;
BEGIN
ASSERT(IsConnected(c), 21);
s := {};
res := WinApi.GetCommModemStatus(c.hnd, s);
ASSERT(res # 0, 100);
RETURN s * WinApi.MS_CTS_ON # {}
END CTSState;
PROCEDURE DSRState* (c: Connection): BOOLEAN;
VAR res: INTEGER; s: SET;
BEGIN
ASSERT(IsConnected(c), 21);
s := {};
res := WinApi.GetCommModemStatus(c.hnd, s);
ASSERT(res # 0, 100);
RETURN s * WinApi.MS_DSR_ON # {}
END DSRState;
PROCEDURE CDState* (c: Connection): BOOLEAN;
VAR res: INTEGER; s: SET;
BEGIN
ASSERT(IsConnected(c), 21);
s := {};
res := WinApi.GetCommModemStatus(c.hnd, s);
ASSERT(res # 0, 100);
RETURN s * WinApi.MS_RLSD_ON # {}
END CDState;
(* Stream*)
PROCEDURE (s: Stream) RemoteAdr* (): CommStreams.Adr;
VAR str: CommStreams.Adr;
BEGIN
NEW(str, LEN(s.remoteAdr));
str^ := s.remoteAdr$;
RETURN str
END RemoteAdr;
PROCEDURE (s: Stream) IsConnected* (): BOOLEAN;
BEGIN
RETURN s.conn # NIL
END IsConnected;
PROCEDURE (s: Stream) WriteBytes* (IN x: ARRAY OF BYTE; beg, len: INTEGER; OUT written: INTEGER);
BEGIN
IF s.IsConnected() THEN
IF len > s.maxWrite THEN written := s.maxWrite
ELSE written := len
END;
SendBytes(s.conn, x, beg, written)
ELSE
written := 0
END
END WriteBytes;
PROCEDURE (s: Stream) ReadBytes* (VAR x: ARRAY OF BYTE; beg, len: INTEGER; OUT read: INTEGER);
BEGIN
IF s.IsConnected() THEN
read := Available(s.conn);
IF read > len THEN read := len END;
ReceiveBytes(s.conn, x, beg, read)
ELSE
read := 0
END
END ReadBytes;
PROCEDURE (s: Stream) Close*;
BEGIN
IF s.IsConnected() THEN
Close(s.conn);
s.conn := NIL
END
END Close;
PROCEDURE ParseParams* (IN params: ARRAY OF CHAR; OUT device: ARRAY OF CHAR; OUT baud: INTEGER; OUT opts: SET): INTEGER;
CONST
maxParamLen = 15;
paramDelimiter = ',';
TYPE
Param = POINTER TO ARRAY maxParamLen OF CHAR;
VAR
par: Param;
i, res, badParamIndex, paramsLen: INTEGER;
read, tooLong: BOOLEAN;
PROCEDURE NextPar(p: Param; OUT read, tooLong: BOOLEAN);
VAR pInd: INTEGER;
BEGIN
pInd := 0;
WHILE (i < paramsLen) & (params[i] # paramDelimiter) & (pInd < maxParamLen - 1) DO
p[pInd] := params[i];
INC(pInd);
INC(i)
END;
IF (i < paramsLen) & (params[i] # paramDelimiter) THEN
tooLong := TRUE;
(* a parameter is too long to fit in par, let's just skip it *)
REPEAT
INC(i)
UNTIL ~((i < paramsLen) & (params[i] # paramDelimiter));
pInd := 0
ELSE
tooLong := FALSE
END;
p[pInd] := 0X;
IF i >= paramsLen THEN
read := pInd > 0
ELSIF params[i] = paramDelimiter THEN
INC(i); (* skip the delimiter on next reading *)
read := TRUE
ELSE
read := FALSE
END;
IF read THEN
INC(badParamIndex)
END
END NextPar;
BEGIN
i := 0;
badParamIndex := 0;
device := 'COM1';
baud := 9600;
opts := {};
paramsLen := LEN(params$);
NEW(par);
NextPar(par, read, tooLong);
IF read THEN
IF tooLong THEN RETURN badParamIndex END;
IF par^ # '' THEN device := par$ END
END;
NextPar(par, read, tooLong);
WHILE read DO
IF tooLong THEN RETURN badParamIndex END;
IF par$ = '' THEN (* ignore empty parameters *)
ELSIF par$ = '1' THEN
ELSIF par$ = '1.5' THEN INCL(opts, stop15)
ELSIF par$ = '2' THEN INCL(opts, stop2)
ELSIF par$ = '4' THEN INCL(opts, bits4)
ELSIF par$ = '5' THEN INCL(opts, bits5)
ELSIF par$ = '6' THEN INCL(opts, bits6)
ELSIF par$ = '7' THEN INCL(opts, bits7)
ELSIF par$ = '8' THEN
ELSIF par$ = 'even' THEN INCL(opts, even)
ELSIF par$ = 'odd' THEN INCL(opts, odd)
ELSIF par$ = 'DTR' THEN INCL(opts, inDTR)
ELSIF par$ = 'DTRon' THEN INCL(opts, inDTRon)
ELSIF par$ = 'DTRoff' THEN
ELSIF par$ = 'RTS' THEN INCL(opts, inRTS)
ELSIF par$ = 'RTSon' THEN INCL(opts, inRTSon)
ELSIF par$ = 'RTSoff' THEN
ELSIF par$ = 'CTS' THEN INCL(opts, outCTS)
ELSIF par$ = 'DSR' THEN INCL(opts, outDSR)
ELSIF par$ = 'inXonXoff' THEN INCL(opts, inXonXoff)
ELSIF par$ = 'outXonXoff' THEN INCL(opts, outXonXoff)
ELSE (* otherwise it should be a baud rate *)
Strings.StringToInt(par, baud, res);
IF (res # 0) OR (baud <= 8) THEN
RETURN badParamIndex (* unknown parameter or invalid baud rate *)
END
END;
NextPar(par, read, tooLong)
END;
RETURN 0
END ParseParams;
PROCEDURE NewStream* (localAdr, remoteAdr: ARRAY OF CHAR; OUT s: CommStreams.Stream; OUT res: INTEGER);
VAR
str: Stream;
device: ARRAY 256 OF CHAR;
baud: INTEGER;
opts: SET;
BEGIN
NEW(str);
NEW(str.remoteAdr, LEN(remoteAdr$) + 1);
str.remoteAdr^ := remoteAdr$;
IF ParseParams(str.remoteAdr, device, baud, opts) = 0 THEN
Open(device, baud, opts, str.conn);
IF str.conn # NIL THEN
(* Here we calculate the maximum bytes written in a single call to WriteBytes. This is the granularity of blocking, since WriteBytes actually blocks. It just won't try to send more than s.maxWrite bytes at once. Although several calls to WriteBytes will block for a longer period of time.
The value here is the baud DIV 1000. In the default configuration (9600 baud, 8 data bits, 1 stop bit, no parity check) this equals 9 bytes which it takes less than 10 msec to send. If you want to block for longer, you may call WriteBytes twice in a succession, which would give you a sum of 20 msec, and so on. If baud = 19200, you would send 19 bytes for the same 10 msec. *)
str.maxWrite := baud DIV 1000;
IF str.maxWrite < 1 THEN str.maxWrite := 1 END;
s := str;
res := CommStreams.done
ELSE
s := NIL;
res := CommStreams.remoteAdrInUse
END
ELSE
res := CommStreams.invalidRemoteAdr
END
END NewStream;
PROCEDURE Init;
BEGIN
root := NIL
END Init;
PROCEDURE CloseAll;
BEGIN
WHILE root # NIL DO
Close(root.conn)
END
END CloseAll;
BEGIN
Init
CLOSE
CloseAll
END CommV24.
Вход
FAQ
Поиск
