synaser.pas - POSIX and Android support by ACBr
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@253 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby
parent
aa1fdbacc4
commit
49454ea6e1
181
synaser.pas
181
synaser.pas
@ -1,9 +1,9 @@
|
||||
{==============================================================================|
|
||||
| Project : Ararat Synapse | 007.006.002 |
|
||||
| Project : Ararat Synapse | 007.007.000 |
|
||||
|==============================================================================|
|
||||
| Content: Serial port support |
|
||||
|==============================================================================|
|
||||
| Copyright (c)2001-2021, Lukas Gebauer |
|
||||
| Copyright (c)2001-2022, Lukas Gebauer |
|
||||
| All rights reserved. |
|
||||
| |
|
||||
| Redistribution and use in source and binary forms, with or without |
|
||||
@ -83,6 +83,15 @@ case with my USB modem):
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF UNIX}
|
||||
{$DEFINE USE_LINUX_LOCK}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF ANDROID}
|
||||
{$DEFINE UNIX}
|
||||
{$UNDEF USE_LINUX_LOCK}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$MODE DELPHI}
|
||||
{$IFDEF MSWINDOWS}
|
||||
@ -96,6 +105,17 @@ case with my USB modem):
|
||||
{define working mode w/o LIBC for fpc}
|
||||
{$DEFINE NO_LIBC}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF POSIX}
|
||||
{$WARN UNIT_PLATFORM OFF}
|
||||
{$WARN SYMBOL_PLATFORM OFF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF NEXTGEN}
|
||||
{$LEGACYIFEND ON}
|
||||
{$ZEROBASEDSTRINGS OFF}
|
||||
{$ENDIF}
|
||||
|
||||
{$Q-}
|
||||
{$H+}
|
||||
{$M+}
|
||||
@ -106,11 +126,18 @@ interface
|
||||
|
||||
uses
|
||||
{$IFNDEF MSWINDOWS}
|
||||
{$IFNDEF NO_LIBC}
|
||||
Libc,
|
||||
KernelIoctl,
|
||||
{$IFDEF POSIX}
|
||||
Posix.Termios, Posix.Fcntl, Posix.Unistd, Posix.Stropts, Posix.SysSelect, Posix.SysTime,
|
||||
{$IFDEF LINUX}
|
||||
Linuxapi.KernelIoctl,
|
||||
{$ENDIF}
|
||||
{$ELSE}
|
||||
termio, baseunix, unix,
|
||||
{$IFNDEF NO_LIBC}
|
||||
Libc,
|
||||
KernelIoctl,
|
||||
{$ELSE}
|
||||
termio, baseunix, unix,
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$IFNDEF FPC}
|
||||
Types,
|
||||
@ -132,6 +159,7 @@ const
|
||||
|
||||
LockfileDirectory = '/var/lock'; {HGJ}
|
||||
PortIsClosed = -1; {HGJ}
|
||||
ErrAccessDenied = 9990; {DSA}
|
||||
ErrAlreadyOwned = 9991; {HGJ}
|
||||
ErrAlreadyInUse = 9992; {HGJ}
|
||||
ErrWrongParameter = 9993; {HGJ}
|
||||
@ -203,7 +231,7 @@ type
|
||||
const
|
||||
{$IFDEF UNIX}
|
||||
{$IFDEF BSD}
|
||||
MaxRates = 18; //MAC
|
||||
MaxRates = 18; //MAC
|
||||
{$ELSE}
|
||||
{$IFDEF CPUARM}
|
||||
MaxRates = 19; //CPUARM
|
||||
@ -261,10 +289,27 @@ const // From fcntl.h
|
||||
O_SYNC = $0080; { synchronous writes }
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF ANDROID}
|
||||
const
|
||||
TIOCMSET = $5418;
|
||||
TIOCMGET = $5415;
|
||||
TCSBRK = $5409;
|
||||
{$ENDIF}
|
||||
|
||||
const
|
||||
sOK = 0;
|
||||
sErr = integer(-1);
|
||||
|
||||
{$IFDEF POSIX}
|
||||
const
|
||||
TIOCM_DTR = $002;
|
||||
TIOCM_RTS = $004;
|
||||
TIOCM_CTS = $020;
|
||||
TIOCM_CAR = $040;
|
||||
TIOCM_RNG = $080;
|
||||
TIOCM_DSR = $100;
|
||||
{$ENDIF}
|
||||
|
||||
type
|
||||
|
||||
{:Possible status event types for @link(THookSerialStatus)}
|
||||
@ -341,9 +386,11 @@ type
|
||||
procedure GetComNr(Value: string); virtual;
|
||||
function PreTestFailing: boolean; virtual;{HGJ}
|
||||
function TestCtrlLine: Boolean; virtual;
|
||||
{$IFDEF UNIX}
|
||||
{$IFNDEF MSWINDOWS}
|
||||
procedure DcbToTermios(const dcb: TDCB; var term: termios); virtual;
|
||||
procedure TermiosToDcb(const term: termios; var dcb: TDCB); virtual;
|
||||
{$ENDIF}
|
||||
{$IFDEF USE_LINUX_LOCK}
|
||||
function ReadLockfile: integer; virtual;
|
||||
function LockfileName: String; virtual;
|
||||
procedure CreateLockfile(PidNr: integer); virtual;
|
||||
@ -354,7 +401,7 @@ type
|
||||
{: data Control Block with communication parameters. Usable only when you
|
||||
need to call API directly.}
|
||||
DCB: Tdcb;
|
||||
{$IFDEF UNIX}
|
||||
{$IFNDEF MSWINDOWS}
|
||||
TermiosStruc: termios;
|
||||
{$ENDIF}
|
||||
{:Object constructor.}
|
||||
@ -632,7 +679,7 @@ type
|
||||
|
||||
{:Raise Synaser error with ErrNumber code. Usually used by internal routines.}
|
||||
procedure RaiseSynaError(ErrNumber: integer); virtual;
|
||||
{$IFDEF UNIX}
|
||||
{$IFDEF USE_LINUX_LOCK}
|
||||
function cpomComportAccessible: boolean; virtual;{HGJ}
|
||||
procedure cpomReleaseComport; virtual; {HGJ}
|
||||
{$ENDIF}
|
||||
@ -807,7 +854,7 @@ begin
|
||||
end;
|
||||
if InstanceActive then
|
||||
begin
|
||||
{$IFDEF UNIX}
|
||||
{$IFDEF USE_LINUX_LOCK}
|
||||
if FLinuxLock then
|
||||
cpomReleaseComport;
|
||||
{$ENDIF}
|
||||
@ -882,7 +929,7 @@ begin
|
||||
sleep(x);
|
||||
end;
|
||||
end;
|
||||
Next := GetTick + Trunc((Length / MaxB) * 1000);
|
||||
Next := GetTick + LongWord(Trunc((Length / MaxB) * 1000));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -946,23 +993,34 @@ begin
|
||||
{$IFNDEF MSWINDOWS}
|
||||
if FComNr <> PortIsClosed then
|
||||
FDevice := '/dev/ttyS' + IntToStr(FComNr);
|
||||
// Comport already owned by another process? {HGJ}
|
||||
if FLinuxLock then
|
||||
if not cpomComportAccessible then
|
||||
begin
|
||||
RaiseSynaError(ErrAlreadyOwned);
|
||||
Exit;
|
||||
end;
|
||||
{$IFNDEF FPC}
|
||||
FHandle := THandle(Libc.open(pchar(FDevice), O_RDWR or O_SYNC));
|
||||
{$ELSE}
|
||||
FHandle := THandle(fpOpen(FDevice, O_RDWR or O_SYNC));
|
||||
{$ENDIF}
|
||||
{$IFDEF USE_LINUX_LOCK}
|
||||
// Comport already owned by another process? {HGJ}
|
||||
if FLinuxLock then
|
||||
if not cpomComportAccessible then
|
||||
begin
|
||||
if FileExists(LockfileName) then
|
||||
RaiseSynaError(ErrAlreadyOwned)
|
||||
else
|
||||
RaiseSynaError(ErrAccessDenied);
|
||||
|
||||
Exit;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFNDEF FPC}
|
||||
{$IFDEF POSIX}
|
||||
FHandle := open(MarshaledAString(AnsiString(FDevice)), O_RDWR or O_SYNC);
|
||||
{$ELSE}
|
||||
FHandle := THandle(Libc.open(pchar(FDevice), O_RDWR or O_SYNC));
|
||||
{$ENDIF}
|
||||
{$ELSE}
|
||||
FHandle := THandle(fpOpen(FDevice, O_RDWR or O_SYNC));
|
||||
{$ENDIF}
|
||||
if FHandle = INVALID_HANDLE_VALUE then //because THandle is not integer on all platforms!
|
||||
SerialCheck(-1)
|
||||
else
|
||||
SerialCheck(0);
|
||||
{$IFDEF UNIX}
|
||||
{$IFDEF USE_LINUX_LOCK}
|
||||
if FLastError <> sOK then
|
||||
if FLinuxLock then
|
||||
cpomReleaseComport;
|
||||
@ -999,7 +1057,7 @@ begin
|
||||
begin
|
||||
SetSynaError(ErrNoDeviceAnswer);
|
||||
FileClose(FHandle); {HGJ}
|
||||
{$IFDEF UNIX}
|
||||
{$IFDEF USE_LINUX_LOCK}
|
||||
if FLinuxLock then
|
||||
cpomReleaseComport; {HGJ}
|
||||
{$ENDIF} {HGJ}
|
||||
@ -1648,7 +1706,11 @@ end;
|
||||
procedure TBlockSerial.SetCommState;
|
||||
begin
|
||||
DcbToTermios(dcb, termiosstruc);
|
||||
SerialCheck(tcsetattr(FHandle, TCSANOW, termiosstruc));
|
||||
{$IfDef POSIX}
|
||||
ioctl(Fhandle, TCSANOW, PInteger(@TermiosStruc));
|
||||
{$Else}
|
||||
SerialCheck(tcsetattr(FHandle, TCSANOW, termiosstruc));
|
||||
{$EndIf}
|
||||
ExceptCheck;
|
||||
end;
|
||||
{$ELSE}
|
||||
@ -1811,7 +1873,7 @@ end;
|
||||
{$IFNDEF MSWINDOWS}
|
||||
function TBlockSerial.CanRead(Timeout: integer): boolean;
|
||||
var
|
||||
FDSet: TFDSet;
|
||||
FDSet: {$IFDEF POSIX}FD_Set{$ELSE}TFDSet{$ENDIF};
|
||||
TimeVal: PTimeVal;
|
||||
TimeV: TTimeVal;
|
||||
x: Integer;
|
||||
@ -1823,7 +1885,7 @@ begin
|
||||
TimeVal := nil;
|
||||
{$IFNDEF FPC}
|
||||
FD_ZERO(FDSet);
|
||||
FD_SET(FHandle, FDSet);
|
||||
{$IFDEF POSIX}_FD_SET{$ELSE}FD_SET{$ENDIF}(FHandle, FDSet);
|
||||
x := Select(FHandle + 1, @FDSet, nil, nil, TimeVal);
|
||||
{$ELSE}
|
||||
fpFD_ZERO(FDSet);
|
||||
@ -1853,7 +1915,7 @@ end;
|
||||
{$IFNDEF MSWINDOWS}
|
||||
function TBlockSerial.CanWrite(Timeout: integer): boolean;
|
||||
var
|
||||
FDSet: TFDSet;
|
||||
FDSet: {$IFDEF POSIX}FD_Set{$ELSE}TFDSet{$ENDIF};
|
||||
TimeVal: PTimeVal;
|
||||
TimeV: TTimeVal;
|
||||
x: Integer;
|
||||
@ -1865,7 +1927,7 @@ begin
|
||||
TimeVal := nil;
|
||||
{$IFNDEF FPC}
|
||||
FD_ZERO(FDSet);
|
||||
FD_SET(FHandle, FDSet);
|
||||
{$IFDEF POSIX}_FD_SET{$ELSE}FD_SET{$ENDIF}(FHandle, FDSet);
|
||||
x := Select(FHandle + 1, nil, @FDSet, nil, TimeVal);
|
||||
{$ELSE}
|
||||
fpFD_ZERO(FDSet);
|
||||
@ -1882,8 +1944,10 @@ begin
|
||||
end;
|
||||
{$ELSE}
|
||||
function TBlockSerial.CanWrite(Timeout: integer): boolean;
|
||||
{$IFDEF WIN32}
|
||||
var
|
||||
t: LongWord;
|
||||
{$ENDIF}
|
||||
begin
|
||||
Result := SendingData = 0;
|
||||
if not Result then
|
||||
@ -1942,7 +2006,11 @@ end;
|
||||
procedure TBlockSerial.Flush;
|
||||
begin
|
||||
{$IFNDEF MSWINDOWS}
|
||||
SerialCheck(tcdrain(FHandle));
|
||||
{$IFDEF ANDROID}
|
||||
ioctl(FHandle, TCSBRK, 1);
|
||||
{$ELSE}
|
||||
SerialCheck(tcdrain(FHandle));
|
||||
{$ENDIF}
|
||||
{$ELSE}
|
||||
SetSynaError(sOK);
|
||||
if not Flushfilebuffers(FHandle) then
|
||||
@ -2197,7 +2265,7 @@ end;
|
||||
Ownership Manager.
|
||||
}
|
||||
|
||||
{$IFDEF UNIX}
|
||||
{$IFDEF USE_LINUX_LOCK}
|
||||
|
||||
function TBlockSerial.LockfileName: String;
|
||||
var
|
||||
@ -2209,8 +2277,13 @@ end;
|
||||
|
||||
procedure TBlockSerial.CreateLockfile(PidNr: integer);
|
||||
var
|
||||
f: TextFile;
|
||||
s: string;
|
||||
{$IFDEF FPC}
|
||||
m: Word;
|
||||
FS: TFileStream;
|
||||
{$ELSE}
|
||||
f: TextFile;
|
||||
{$ENDIF}
|
||||
begin
|
||||
// Create content for file
|
||||
s := IntToStr(PidNr);
|
||||
@ -2218,6 +2291,7 @@ begin
|
||||
s := ' ' + s;
|
||||
// Create file
|
||||
try
|
||||
{$IFNDEF FPC}
|
||||
AssignFile(f, LockfileName);
|
||||
try
|
||||
Rewrite(f);
|
||||
@ -2225,6 +2299,21 @@ begin
|
||||
finally
|
||||
CloseFile(f);
|
||||
end;
|
||||
{$ELSE}
|
||||
s := s + sLineBreak;
|
||||
if FileExists(LockfileName) then
|
||||
m := fmOpenReadWrite
|
||||
else
|
||||
m := fmCreate;
|
||||
FS := TFileStream.Create(LockfileName, m or fmShareDenyWrite);
|
||||
try
|
||||
FS.Seek(0, soEnd);
|
||||
FS.Write(Pointer(s)^, Length(s));
|
||||
finally
|
||||
FS.Free ;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
// Allow all users to enjoy the benefits of cpom
|
||||
s := 'chmod a+rw ' + LockfileName;
|
||||
{$IFNDEF FPC}
|
||||
@ -2263,7 +2352,7 @@ var
|
||||
begin
|
||||
Filename := LockfileName;
|
||||
{$IFNDEF FPC}
|
||||
MyPid := Libc.getpid;
|
||||
MyPid := {$IFNDEF POSIX}Libc.{$ENDIF}getpid;
|
||||
{$ELSE}
|
||||
MyPid := fpGetPid;
|
||||
{$ENDIF}
|
||||
@ -2271,20 +2360,20 @@ begin
|
||||
if not DirectoryExists(LockfileDirectory) then
|
||||
CreateDir(LockfileDirectory);
|
||||
// Check the Lockfile
|
||||
if not FileExists (Filename) then
|
||||
if not FileExists(Filename) then
|
||||
begin // comport is not locked. Lock it for us.
|
||||
CreateLockfile(MyPid);
|
||||
result := true;
|
||||
result := FileExists(Filename);
|
||||
exit; // done.
|
||||
end;
|
||||
// Is port owned by orphan? Then it's time for error recovery.
|
||||
//FPC forgot to add getsid.. :-(
|
||||
{$IFNDEF FPC}
|
||||
if Libc.getsid(ReadLockfile) = -1 then
|
||||
if {$IFNDEF POSIX}Libc.{$ENDIF}getsid(ReadLockfile) = -1 then
|
||||
begin // Lockfile was left from former desaster
|
||||
DeleteFile(Filename); // error recovery
|
||||
CreateLockfile(MyPid);
|
||||
result := true;
|
||||
result := FileExists(Filename);
|
||||
exit;
|
||||
end;
|
||||
{$ENDIF}
|
||||
@ -2330,13 +2419,15 @@ end;
|
||||
{$ENDIF}
|
||||
{$IFNDEF MSWINDOWS}
|
||||
function GetSerialPortNames: string;
|
||||
const
|
||||
ATTR = {$IFDEF POSIX}$7FFFFFFF{$ELSE}$FFFFFFFF{$ENDIF};
|
||||
var
|
||||
sr : TSearchRec;
|
||||
begin
|
||||
Result := '';
|
||||
if FindFirst('/dev/ttyS*', $FFFFFFFF, sr) = 0 then
|
||||
if FindFirst('/dev/ttyS*', ATTR, sr) = 0 then
|
||||
repeat
|
||||
if (sr.Attr and $FFFFFFFF) = Sr.Attr then
|
||||
if (sr.Attr and ATTR) = Sr.Attr then
|
||||
begin
|
||||
if Result <> '' then
|
||||
Result := Result + ',';
|
||||
@ -2344,18 +2435,18 @@ begin
|
||||
end;
|
||||
until FindNext(sr) <> 0;
|
||||
FindClose(sr);
|
||||
if FindFirst('/dev/ttyUSB*', $FFFFFFFF, sr) = 0 then begin
|
||||
if FindFirst('/dev/ttyUSB*', ATTR, sr) = 0 then begin
|
||||
repeat
|
||||
if (sr.Attr and $FFFFFFFF) = Sr.Attr then begin
|
||||
if (sr.Attr and ATTR) = Sr.Attr then begin
|
||||
if Result <> '' then Result := Result + ',';
|
||||
Result := Result + '/dev/' + sr.Name;
|
||||
end;
|
||||
until FindNext(sr) <> 0;
|
||||
end;
|
||||
FindClose(sr);
|
||||
if FindFirst('/dev/ttyAM*', $FFFFFFFF, sr) = 0 then begin
|
||||
if FindFirst('/dev/ttyAM*', ATTR, sr) = 0 then begin
|
||||
repeat
|
||||
if (sr.Attr and $FFFFFFFF) = Sr.Attr then begin
|
||||
if (sr.Attr and ATTR) = Sr.Attr then begin
|
||||
if Result <> '' then Result := Result + ',';
|
||||
Result := Result + '/dev/' + sr.Name;
|
||||
end;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user