fix(cat): транспорты — короткая запись в TCP и молчаливый отказ serial-порта

CATTcp.SendStr делал один send на ответ. TCP не обязан отдавать весь буфер за
раз, а усечение здесь не ошибка — длинный ответ (IF, ZZEB, список режимов) мог
уехать обрезанным, и молча. Дописываем остаток в цикле.

CATSerial помечал порт активным ДО SerOpen, а открытие шло внутри потока: при
отказе порт навсегда оставался «работающим» в ActiveCount и UI, а причина
нигде не оседала. Открытие переехало в TCATSerialPort.Start и делается
синхронно, так что отказ виден сразу — FActive остаётся False, причина в новом
свойстве LastError. Поток теперь только читает, закрывает владелец в Stop.

Заодно Andromeda-порт назначался по галке в настройках, без оглядки на то,
поднялся ли порт: HasAndromeda рапортовал о панели, которой нет.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
2026-08-17 13:13:46 +03:00
co-authored by Claude Opus 5
parent 27a8d1d5cf
commit 20bf3c1f39
2 changed files with 91 additions and 62 deletions
+70 -51
View File
@@ -63,7 +63,6 @@ type
FHandle: TSerialHandle;
FBuf: string;
procedure ProcessBuffer;
function TryOpenPort: Boolean;
protected
procedure Execute; override;
public
@@ -79,6 +78,9 @@ type
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;
@@ -89,6 +91,9 @@ type
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 }
@@ -120,40 +125,6 @@ begin
inherited Create(True);
end;
function TCATSerialThread.TryOpenPort: Boolean;
{$IFNDEF CAT_SERIAL_STUB}
var
cfg: TCATSerialConfig;
h: TSerialHandle;
par: TParityType;
{$ENDIF}
begin
Result := False;
{$IFDEF CAT_SERIAL_STUB}
Exit;
{$ELSE}
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;
{$ENDIF}
end;
procedure TCATSerialThread.ProcessBuffer;
var
tpos: Integer;
@@ -173,6 +144,8 @@ begin
end;
procedure TCATSerialThread.Execute;
// Порт уже открыт владельцем (TCATSerialPort.Start) — поток только читает.
// Закрывает тоже владелец, в Stop, после WaitFor.
var
ch: Byte;
n: LongInt;
@@ -180,22 +153,13 @@ begin
{$IFDEF CAT_SERIAL_STUB}
Exit;
{$ELSE}
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;
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;
finally
SerClose(FHandle);
{$IFDEF MSWINDOWS}
FOwner.Handle := INVALID_HANDLE_VALUE;
{$ELSE}
FOwner.Handle := -1;
{$ENDIF}
end;
{$ENDIF}
end;
@@ -223,9 +187,61 @@ begin
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;
@@ -240,6 +256,7 @@ begin
FThread.WaitFor;
FreeAndNil(FThread);
end;
ClosePort;
end;
procedure TCATSerialPort.SendStr(const S: string);
@@ -294,7 +311,9 @@ begin
for i := 0 to cnt-1 do begin
FPorts[i] := TCATSerialPort.Create(FEngine, Configs[i]);
if Configs[i].Enabled then FPorts[i].Start;
if Configs[i].Enabled and Configs[i].Andromeda and (FAndromedaPort = nil) then
// Панель назначаем только на РЕАЛЬНО поднявшийся порт: раньше хватало галки
// в настройках, и HasAndromeda рапортовал о панели, которой нет.
if FPorts[i].Active and Configs[i].Andromeda and (FAndromedaPort = nil) then
FAndromedaPort := FPorts[i];
end;
end;