Difference between revisions of "Serial unit"
From Lazarus wiki
Jump to navigationJump to searchLine 6: | Line 6: | ||
Program TestSerialPortCom; | Program TestSerialPortCom; | ||
{ | { | ||
− | Usage | + | Usage: |
− | TestSerialPortCom | + | TestSerialPortCom |
− | TestSerialPortCom 8 'Hello' | + | Uses default port COM1. |
+ | TestSerialPortCom 8 'Hello' | ||
+ | Uses COM8 and outputs 'Hello' before waiting for an answer. | ||
− | + | The program will open a serial port and output 'Hello', after that the code will wait until | |
a CR (#13) is received, or a key is pressed. | a CR (#13) is received, or a key is pressed. | ||
} | } | ||
Line 16: | Line 18: | ||
serial, crt; | serial, crt; | ||
− | + | var | |
serialhandle : LongInt; | serialhandle : LongInt; | ||
ComPortName : String; | ComPortName : String; | ||
Line 27: | Line 29: | ||
ErrorCode : Integer; | ErrorCode : Integer; | ||
− | + | begin | |
ComPortNr:= 1; | ComPortNr:= 1; | ||
tmpstr:= ''; | tmpstr:= ''; | ||
txt:= ''; | txt:= ''; | ||
− | writeln('Parameters ', ParamCount); | + | writeln('Parameters: ', ParamCount); |
if (ParamCount>0) then | if (ParamCount>0) then | ||
begin | begin | ||
Line 39: | Line 41: | ||
if (ParamCount>1) then | if (ParamCount>1) then | ||
− | |||
txt:= ParamStr(2); | txt:= ParamStr(2); | ||
− | |||
− | |||
end; | end; | ||
Line 48: | Line 47: | ||
ComPortName:= 'COM'+tmpstr+':'; | ComPortName:= 'COM'+tmpstr+':'; | ||
− | writeln('Using '+ComPortname); | + | writeln('Using: '+ComPortname); |
serialhandle := SerOpen(ComPortName); | serialhandle := SerOpen(ComPortName); | ||
− | Flags:= [ ]; // None | + | Flags:= []; // None |
− | SerSetParams(serialhandle,9600,8,NoneParity,1,Flags); | + | SerSetParams(serialhandle, 9600, 8, NoneParity, 1, Flags); |
− | s:=txt; // use the input text | + | s:= txt; // use the input text |
− | writeln(' | + | writeln('Output: '+s); |
− | s:=s+#13+#10; | + | s:= s+#13+#10; // CR + LF |
writecount:= length(s); | writecount:= length(s); | ||
− | status:= SerWrite(serialhandle, s[1], writecount ); | + | status:= SerWrite(serialhandle, s[1], writecount); |
− | // | + | // For debugging only |
− | writeln(' | + | writeln('Status: ', status, ', WriteCount: ', writecount); |
if status > 0 then | if status > 0 then | ||
begin | begin | ||
writeln('Waiting for answer'); | writeln('Waiting for answer'); | ||
− | + | s:= ''; | |
− | s:=''; | + | ComIn:= ''; |
− | ComIn:=''; | + | while (Length(ComIn)<10) and (status>=0) and not KeyPressed do |
− | while (Length( | + | begin |
− | |||
status:= SerRead(serialhandle, s[1], 10); | status:= SerRead(serialhandle, s[1], 10); | ||
− | if (s[1]=#13) then status:=-1; | + | if (s[1]=#13) then |
+ | status:= -1; // CR => end serial read | ||
− | if (status>0) then ComIn:=ComIn+s[1]; | + | if (status>0) then |
− | + | begin | |
− | writeln(status,' ',length(ComIn),' ASCII ',ord(s[1]),' | + | ComIn:= ComIn+s[1]; |
− | end; | + | writeln('Status: ', status, ', Len: ', length(ComIn), ', ASCII: ', ord(s[1]), ', Input: ', ComIn); |
+ | end; | ||
end; | end; | ||
end | end | ||
else | else | ||
− | writeln(' | + | writeln('Error: unable to send'); |
− | SerSync(serialhandle); | + | SerSync(serialhandle); // flush out any remaining before closure |
− | SerFlushOutput(serialhandle); | + | SerFlushOutput(serialhandle); // discard any remaining output |
SerClose(serialhandle); | SerClose(serialhandle); | ||
− | + | end. | |
</syntaxhighlight> | </syntaxhighlight> | ||
Revision as of 16:55, 19 September 2022
Unit Serial in FPC supports work with serial port. It provides many Ser* functions.
Example of usage
Program TestSerialPortCom;
{
Usage:
TestSerialPortCom
Uses default port COM1.
TestSerialPortCom 8 'Hello'
Uses COM8 and outputs 'Hello' before waiting for an answer.
The program will open a serial port and output 'Hello', after that the code will wait until
a CR (#13) is received, or a key is pressed.
}
uses
serial, crt;
var
serialhandle : LongInt;
ComPortName : String;
s,tmpstr,txt : String;
ComIn : String;
ComPortNr : integer;
writecount : integer;
status : LongInt;
Flags : TSerialFlags; { TSerialFlags = set of (RtsCtsFlowControl); }
ErrorCode : Integer;
begin
ComPortNr:= 1;
tmpstr:= '';
txt:= '';
writeln('Parameters: ', ParamCount);
if (ParamCount>0) then
begin
tmpstr:= ParamStr(1);
val(tmpstr, ComPortNr, ErrorCode);
if (ParamCount>1) then
txt:= ParamStr(2);
end;
str(ComPortNr,tmpstr);
ComPortName:= 'COM'+tmpstr+':';
writeln('Using: '+ComPortname);
serialhandle := SerOpen(ComPortName);
Flags:= []; // None
SerSetParams(serialhandle, 9600, 8, NoneParity, 1, Flags);
s:= txt; // use the input text
writeln('Output: '+s);
s:= s+#13+#10; // CR + LF
writecount:= length(s);
status:= SerWrite(serialhandle, s[1], writecount);
// For debugging only
writeln('Status: ', status, ', WriteCount: ', writecount);
if status > 0 then
begin
writeln('Waiting for answer');
s:= '';
ComIn:= '';
while (Length(ComIn)<10) and (status>=0) and not KeyPressed do
begin
status:= SerRead(serialhandle, s[1], 10);
if (s[1]=#13) then
status:= -1; // CR => end serial read
if (status>0) then
begin
ComIn:= ComIn+s[1];
writeln('Status: ', status, ', Len: ', length(ComIn), ', ASCII: ', ord(s[1]), ', Input: ', ComIn);
end;
end;
end
else
writeln('Error: unable to send');
SerSync(serialhandle); // flush out any remaining before closure
SerFlushOutput(serialhandle); // discard any remaining output
SerClose(serialhandle);
end.
When timeout starts
Q: I'm trying to figure out when the timeout timer in SerRead/SerReadTimeout starts.
A (by FPC developer Christo Crause): FPC uses the OS provided functionality to interact with the serial port. On Windows the timeout seems to start when the read request is made - Link. On POSIX (at least Linux) it depends on the specific set of flags specified , scroll down to the discussion on canonical/noncanonical mode for the details - Link.