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} interface uses Classes, SysUtils, Serial, // FPC cross-platform serial unit {$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; end; TCATSerialPort = class; { TCATSerialThread — per-port listener thread } TCATSerialThread = class(TThread) private FOwner: TCATSerialPort; FHandle: TSerialHandle; FBuf: string; procedure ProcessBuffer; function TryOpenPort: Boolean; 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; 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; end; { TCATSerialManager — manages up to 4 serial ports } TCATSerialManager = class private FPorts: array[0..CAT_SERIAL_MAX_PORTS-1] of TCATSerialPort; FEngine: TCATEngine; public constructor Create(AEngine: TCATEngine); destructor Destroy; override; procedure ApplyConfig(const Configs: array of TCATSerialConfig); procedure StopAll; function ActiveCount: Integer; end; implementation { ── TCATSerialThread ──────────────────────────────────────────────────────── } constructor TCATSerialThread.Create(AOwner: TCATSerialPort); begin FOwner := AOwner; FBuf := ''; FreeOnTerminate := False; inherited Create(True); end; function TCATSerialThread.TryOpenPort: Boolean; var cfg: TCATSerialConfig; h: TSerialHandle; par: TParityType; begin Result := False; cfg := FOwner.Config; h := SerOpen(cfg.PortName); {$IFDEF MSWINDOWS} if h = TSerialHandle(INVALID_HANDLE_VALUE) then Exit; {$ELSE} if h < 0 then Exit; {$ENDIF} case cfg.Parity of cspNone: par := Serial.NoneParity; cspOdd: par := Serial.OddParity; cspEven: par := Serial.EvenParity; else par := Serial.NoneParity; end; SerSetParams(h, cfg.BaudRate, cfg.DataBits, par, cfg.StopBits, []); FHandle := h; FOwner.Handle := h; Result := 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; var ch: Byte; n: LongInt; begin if not TryOpenPort then Exit; try 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; finally SerClose(FHandle); {$IFDEF MSWINDOWS} FOwner.Handle := INVALID_HANDLE_VALUE; {$ELSE} FOwner.Handle := -1; {$ENDIF} end; 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; procedure TCATSerialPort.Start; begin if FActive or not FConfig.Enabled then Exit; 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; end; procedure TCATSerialPort.SendStr(const S: string); var buf: AnsiString; begin {$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; end; { ── TCATSerialManager ─────────────────────────────────────────────────────── } constructor TCATSerialManager.Create(AEngine: TCATEngine); var i: Integer; begin inherited Create; FEngine := AEngine; 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; end; end; procedure TCATSerialManager.StopAll; var i: Integer; begin 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.