unit CATSerial; { CATSerial.pas — CAT через последовательные порты (до 4 штук). Каждый порт запускает отдельный поток-слушатель, который: 1. Читает байты из COM/ttyS порта 2. Накапливает их в буфер до символа ';' 3. Передаёт команду в TCATEngine.Parse() 4. Отправляет ответ обратно в порт Платформы: • Linux : /dev/ttyS0..3, /dev/ttyUSB0, etc. • Windows: COM1..COM4 (имя порта вводится вручную) Зависимости: CATEngine, Serial (FPC fcl-serial RTL unit) } {$IFDEF FPC} {$MODE Delphi} {$ENDIF} {$IFDEF DARWIN} {$DEFINE CAT_SERIAL_STUB} {$ENDIF} interface uses Classes, SysUtils, {$IFNDEF CAT_SERIAL_STUB} Serial, // FPC cross-platform serial unit {$ENDIF} {$IFDEF MSWINDOWS}Windows,{$ENDIF} SyncObjs, CATEngine; const CAT_SERIAL_MAX_PORTS = 4; CAT_SERIAL_BUF_SIZE = 256; type TCATSerialParity = (cspNone, cspOdd, cspEven); TCATSerialConfig = record Enabled: Boolean; PortName: string; // e.g. '/dev/ttyS0' or 'COM1' BaudRate: Integer; // 1200, 2400, 4800, 9600, 19200, 38400, 57600, 115200 DataBits: Integer; // 7 or 8 StopBits: Integer; // 1 or 2 Parity: TCATSerialParity; Andromeda: Boolean; // порт — передняя панель Andromeda/G2 (push ZZZI наружу) end; {$IFDEF CAT_SERIAL_STUB} TSerialHandle = PtrInt; {$ENDIF} TCATSerialPort = class; { TCATSerialThread — per-port listener thread } TCATSerialThread = class(TThread) private FOwner: TCATSerialPort; FHandle: TSerialHandle; FBuf: string; procedure ProcessBuffer; protected procedure Execute; override; public constructor Create(AOwner: TCATSerialPort); end; { TCATSerialPort — one serial CAT port } TCATSerialPort = class private FConfig: TCATSerialConfig; FEngine: TCATEngine; FThread: TCATSerialThread; FHandle: TSerialHandle; FLock: TCriticalSection; FActive: Boolean; FLastError: string; function OpenPort: Boolean; // синхронно, из Start — чтобы отказ был виден сразу procedure ClosePort; public constructor Create(AEngine: TCATEngine; const ACfg: TCATSerialConfig); destructor Destroy; override; procedure Start; procedure Stop; procedure SendStr(const S: string); property Handle: TSerialHandle read FHandle write FHandle; property Config: TCATSerialConfig read FConfig; property Engine: TCATEngine read FEngine; property Active: Boolean read FActive; // Причина, по которой порт не поднялся (пусто, если поднялся). Раньше отказ // SerOpen нигде не оседал, а порт продолжал числиться активным. property LastError: string read FLastError; end; { TCATSerialManager — manages up to 4 serial ports } TCATSerialManager = class private FPorts: array[0..CAT_SERIAL_MAX_PORTS-1] of TCATSerialPort; FEngine: TCATEngine; FAndromedaPort: TCATSerialPort; // первый активный порт с Andromeda=true (или nil) public constructor Create(AEngine: TCATEngine); destructor Destroy; override; procedure ApplyConfig(const Configs: array of TCATSerialConfig); procedure StopAll; function ActiveCount: Integer; // Передняя панель: есть ли активный Andromeda-порт и отправка строки в него. function HasAndromeda: Boolean; procedure SendToAndromeda(const S: string); // сигнатура совместима с TAndromedaSend end; implementation { ── TCATSerialThread ──────────────────────────────────────────────────────── } constructor TCATSerialThread.Create(AOwner: TCATSerialPort); begin FOwner := AOwner; FBuf := ''; FreeOnTerminate := False; inherited Create(True); end; procedure TCATSerialThread.ProcessBuffer; var tpos: Integer; cmd, resp: string; begin repeat tpos := Pos(';', FBuf); if tpos = 0 then Break; cmd := Copy(FBuf, 1, tpos); Delete(FBuf, 1, tpos); resp := FOwner.Engine.Parse(cmd); if resp <> '' then FOwner.SendStr(resp); until tpos = 0; // Guard against runaway buffers (no terminator seen in 256+ chars) if Length(FBuf) > CAT_SERIAL_BUF_SIZE then FBuf := ''; end; procedure TCATSerialThread.Execute; // Порт уже открыт владельцем (TCATSerialPort.Start) — поток только читает. // Закрывает тоже владелец, в Stop, после WaitFor. var ch: Byte; n: LongInt; begin {$IFDEF CAT_SERIAL_STUB} Exit; {$ELSE} FHandle := FOwner.Handle; while not Terminated do begin n := SerReadTimeout(FHandle, ch, 50); if n = 1 then begin FBuf := FBuf + Chr(ch); if ch = Ord(';') then ProcessBuffer; end; end; {$ENDIF} end; { ── TCATSerialPort ────────────────────────────────────────────────────────── } constructor TCATSerialPort.Create(AEngine: TCATEngine; const ACfg: TCATSerialConfig); begin inherited Create; FEngine := AEngine; FConfig := ACfg; {$IFDEF MSWINDOWS} FHandle := INVALID_HANDLE_VALUE; {$ELSE} FHandle := -1; {$ENDIF} FLock := TCriticalSection.Create; FActive := False; end; destructor TCATSerialPort.Destroy; begin Stop; FLock.Free; inherited; end; function TCATSerialPort.OpenPort: Boolean; {$IFNDEF CAT_SERIAL_STUB} var h: TSerialHandle; par: TParityType; {$ENDIF} begin Result := False; {$IFDEF CAT_SERIAL_STUB} FLastError := 'serial support not built on this platform'; {$ELSE} h := SerOpen(FConfig.PortName); {$IFDEF MSWINDOWS} if h = TSerialHandle(INVALID_HANDLE_VALUE) then {$ELSE} if h < 0 then {$ENDIF} begin FLastError := 'не удалось открыть ' + FConfig.PortName; Exit; end; case FConfig.Parity of cspNone: par := Serial.NoneParity; cspOdd: par := Serial.OddParity; cspEven: par := Serial.EvenParity; else par := Serial.NoneParity; end; SerSetParams(h, FConfig.BaudRate, FConfig.DataBits, par, FConfig.StopBits, []); FHandle := h; FLastError := ''; Result := True; {$ENDIF} end; procedure TCATSerialPort.ClosePort; begin {$IFNDEF CAT_SERIAL_STUB} {$IFDEF MSWINDOWS} if FHandle <> INVALID_HANDLE_VALUE then SerClose(FHandle); FHandle := INVALID_HANDLE_VALUE; {$ELSE} if FHandle >= 0 then SerClose(FHandle); FHandle := -1; {$ENDIF} {$ENDIF} end; procedure TCATSerialPort.Start; // Порт открываем ЗДЕСЬ, а не в потоке: иначе отказ SerOpen оставался внутри // потока, а порт всё это время числился активным — и в ActiveCount, и в UI. begin if FActive or not FConfig.Enabled then Exit; if not OpenPort then Exit; // FActive остаётся False, причина — в LastError FActive := True; FThread := TCATSerialThread.Create(Self); FThread.Start; end; procedure TCATSerialPort.Stop; begin if not FActive then Exit; FActive := False; if Assigned(FThread) then begin FThread.Terminate; FThread.WaitFor; FreeAndNil(FThread); end; ClosePort; end; procedure TCATSerialPort.SendStr(const S: string); var buf: AnsiString; begin {$IFDEF CAT_SERIAL_STUB} Exit; {$ELSE} {$IFDEF MSWINDOWS} if FHandle = INVALID_HANDLE_VALUE then Exit; {$ELSE} if FHandle < 0 then Exit; {$ENDIF} FLock.Acquire; try buf := AnsiString(S); if Length(buf) > 0 then SerWrite(FHandle, buf[1], Length(buf)); except // ignore write errors (port may have been closed) end; FLock.Release; {$ENDIF} end; { ── TCATSerialManager ─────────────────────────────────────────────────────── } constructor TCATSerialManager.Create(AEngine: TCATEngine); var i: Integer; begin inherited Create; FEngine := AEngine; FAndromedaPort := nil; for i := 0 to CAT_SERIAL_MAX_PORTS-1 do FPorts[i] := nil; end; destructor TCATSerialManager.Destroy; begin StopAll; inherited; end; procedure TCATSerialManager.ApplyConfig(const Configs: array of TCATSerialConfig); var i: Integer; cnt: Integer; begin StopAll; cnt := Length(Configs); if cnt > CAT_SERIAL_MAX_PORTS then cnt := CAT_SERIAL_MAX_PORTS; for i := 0 to cnt-1 do begin FPorts[i] := TCATSerialPort.Create(FEngine, Configs[i]); if Configs[i].Enabled then FPorts[i].Start; // Панель назначаем только на РЕАЛЬНО поднявшийся порт: раньше хватало галки // в настройках, и HasAndromeda рапортовал о панели, которой нет. if FPorts[i].Active and Configs[i].Andromeda and (FAndromedaPort = nil) then FAndromedaPort := FPorts[i]; end; end; function TCATSerialManager.HasAndromeda: Boolean; begin Result := Assigned(FAndromedaPort); end; procedure TCATSerialManager.SendToAndromeda(const S: string); begin if Assigned(FAndromedaPort) then FAndromedaPort.SendStr(S); end; procedure TCATSerialManager.StopAll; var i: Integer; begin FAndromedaPort := nil; // указывает в FPorts[] — обнулить ДО освобождения for i := 0 to CAT_SERIAL_MAX_PORTS-1 do begin if Assigned(FPorts[i]) then begin FPorts[i].Stop; FreeAndNil(FPorts[i]); end; end; end; function TCATSerialManager.ActiveCount: Integer; var i: Integer; begin Result := 0; for i := 0 to CAT_SERIAL_MAX_PORTS-1 do if Assigned(FPorts[i]) and FPorts[i].Active then Inc(Result); end; end.