Free Homepage(* COMx interface in Windows,
written with Borland
Pascal 7 for Windows.
Franz Glaser, Austria.
http://members.eunet.at/meg-glaser
meg-glaser@eunet.at
Turbo Pascal page:
http://geo.meg-glaser.at/tp.html
The name "AUX" is historic, coming from the
CP/M-86 and Concurrent CP/M
operating systems.
Windows handles the COMx serial ports in another
manner than DOS does,
in particular it works with data blocks,
instead of single characters.
Thus it does not loose characters even if
the app program is not in the
foreground. No interrupt handling is necessary
in the app program. This
is very similar to the Concurrent-DOS / DR-Multiuser-DOS
and REAL/32
handling of the serial ports.
The routines are proven to run in Win 3.1x
and Win95, they were never
checked with Windows NT.
If you run higher baud rates than 19200 you
can detect problems with
cheap video cards, which disable interrupts
for long time intervals.
Sometimes it helps to upgrade the hardware
to 16550A UART controllers.
There are special cards for 8 and 16 channels
available from TCL in UK,
having an on-board processor which handles
the ports with high speed.
*)
Interface
Uses WinTypes, WinProcs, Strings;
Procedure OpenMyComm;
Procedure CloseMyComm;
Function Aux_InStat : Integer;
Function Aux_OutStat : Integer;
Function Aux_ReadBlk(Var Buff; Size : Integer):Integer;
Function Aux_WriteBlk(Var Buff; Size : Integer):Integer;
Var MyCid : Integer; {this ID is the "handle"
throughout the program}
SetCommResult : Integer;
GetCommErrorResult : Integer;
ComName : Array[0..16] of Char;
Implementation
Const
{ Comm Baud Rate indices, Gl: from
WIN31.PAS }
cbr_110 = $FF10;
cbr_300 = $FF11;
cbr_600 = $FF12;
cbr_1200 = $FF13;
cbr_2400 = $FF14;
cbr_4800 = $FF15;
cbr_9600 = $FF16;
cbr_14400 = $FF17;
cbr_19200 = $FF18;
cbr_38400 = $FF1B;
cbr_56000 = $FF1F;
cbr_128000 = $FF23;
cbr_256000 = $FF27;
Var
MyTDCB : TDCB;
MyTComStat : TComStat;
Procedure OpenMyComm; {usually invoked at
program start}
Begin
SetCommResult := -1;
GetCommErrorResult := -1;
{in Windows the channel must be opened /
occupied for the app-program}
MyCid := OpenComm(ComName,1024,1024); {buffer
sizes, app dependant}
{setup with parameters}
fillchar(MyTDCB,sizeof(MyTDCB),#0);
if MyCid >= 0 then {if COMx is available}
with MyTDCB do
Begin
Id := MyCid;
BaudRate := CBR_19200;
{could be a setup variable}
ByteSize := 8;
Parity :=
0;
StopBits := 0; {1
stop-bit}
RlsTimeout := 0;
CtsTimeout := 0;
DsrTimeout := 0;
Flags
:= $0001; {fBinary}
XOnChar := ^Q;
XOffChar := ^S;
XonLim :=
512; {Xon/Xoff not enabled, but setup}
XoffLim := 768;
PeChar :=
#0;
EOFchar := ^Z;
EvtChar := #0;
TxDelay := 0;
SetCommResult := SetCommState(MyTDCB);
End;
if SetCommResult = 0 then
GetCommErrorResult := GetCommError(MyCid,MyTComStat);
End;
Procedure CloseMyComm; {must be called upon
program termination}
Begin
CloseComm(MyCid); {release the COMx
port}
End;
Function Aux_InStat : Integer; {# of rx-ed
chars in inbuffer}
Begin
GetCommErrorResult := GetCommError(MyCid,MyTComStat);
Aux_InStat := MyTComStat.cbInQue;
End;
Function Aux_OutStat : Integer; {# of space
in outbuffer}
Begin
GetCommErrorResult := GetCommError(MyCid,MyTComStat);
Aux_OutStat := MyTComStat.cbOutQue;
End;
Function Aux_ReadBlk(Var Buff; Size : Integer):Integer;
Begin
{size = max chars to read from buffer}
Aux_ReadBlk := ReadComm(MyCid,PChar(@Buff),Size);
End;
Function Aux_WriteBlk(Var Buff; Size : Integer):Integer;
Begin
GetCommErrorResult := GetCommError(MyCid,MyTComStat);
if Size > 0 then {for security, nobody
would write 0 chars intentionally}
Aux_WriteBlk := WriteComm(MyCid,PChar(@Buff),Size)
else
Aux_WriteBlk := 0;
End;
{Unit initialisation}
Begin
StrPCopy(ComName,'COM1'); {could be
a setup variable as well}
End.
{---------------------------------------------------------------}
{Application example and other stuff}
Var SrvChkMem : Array[0..15] of Byte;
(* this function is the most simple example
of a usage of the comm
routines above.
It is part of a program, where
a Windows app was connected to a
special server for file transfer.
*)
Function SrvCheckServer : Boolean; {some
kind of "ping", are you ready, server?}
Var P : Integer;
TimO : Longint;
Begin
EmptyRxBuffer;
SrvCheckServer := false;
Word(SrvChkMem) := cpcCheck; {this
was for a particular program, do not mind!}
P := 0; TimO := 20;
while (P < 2) do {write 2 bytes to comx}
Begin
P := AUX_WRITEBLK(SrvChkMem[P],2-P)+P;
Delay(1);
Dec(TimO);
if TimO < 1 then Exit; {timeout
writing, should never occur}
End;
Delay(1); TimO := 20;
while AUX_OUTSTAT <> 0 do {wait
until physically written}
Begin
Delay(1);
Dec(TimO);
if TimO < 1 then Exit; {timeout
physical out, should never occur}
End;
{now read back the response of the "server":}
P := 0; TimO := 70; {max time to respond}
while (P < 15) do {read 15
bytes of response}
Begin
P := AUX_READBLK(SrvChkMem[P],15-P)+P;
Delay(1);
Dec(TimO);
if TimO < 1 then Exit; {timeout,
server does not respond}
End;
if Word(SrvChkMem) = cprCheck then {from
the particular application, do not mind!}
Begin
SrvCheckServer := true; {"server"
responded ok, "I'm alive and ready"}
End;
End;
{-------- other usefule routines ----------}
Function GetCRC(Var Buff; Len : Word):Word; {works
with global DS: buffers only}
Begin
ASM
MOV DX,Len
LES SI,Buff {ES
ignored}
XOR BX,BX
CLD
@@N:
MOV CX,8
LODSB
@@L:
RCL AL,1
RCL BX,1
JNB @@0
XOR BX,$1021
@@0:
LOOP @@L
DEC DX
JNZ @@N
MOV DX,0002H
@@K:
MOV CX,8
MOV AX,0000H
@@M:
RCL AL,1
RCL BX,1
JNC @@1
XOR BX,$1021
@@1:
LOOP @@M
DEC DX
JNZ @@K
@@E:
MOV @Result,BX
END;
End;
(*this simple delay procedure gives control
to the other
application - tasks while waiting,
used above*)
Procedure Delay(ms : LongInt);
Var
TickCount : LongInt;
M : TMsg;
Begin
TickCount := GetTickCount;
While GetTickCount - TickCount < ms do
If PeekMessage(M,0,0,0,pm_Remove) then
Begin
TranslateMessage(M);
DispatchMessage(M);
End;
End;
Tiny application program, where the procedures above were used to connect
to a DR-Multiuser DOS server.
The server process is written especially to run in background with
very little CPU power consumption.
| Quelle | source |
| Ziel | destination |
| Verzeichnis | subdirectory |
| Datei Dateien | file, files |
| suchen | search |
| holen | fetch, download |
| Zeit | time |
| frei | free |
| löschen | erase, delete |
| Joker | wildcard |
Free Homepage