mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 17:27:32 +00:00
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:
+70
-51
@@ -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;
|
||||
|
||||
+21
-11
@@ -161,22 +161,32 @@ begin
|
||||
end;
|
||||
|
||||
procedure TCATTcpClientThread.SendStr(const S: string);
|
||||
// TCP не обязан отдавать весь буфер за один send: длинный ответ (IF, ZZEB,
|
||||
// список режимов) мог уехать обрезанным — и молча, потому что усечение здесь
|
||||
// не ошибка. Дописываем остаток, пока он есть.
|
||||
var
|
||||
buf: AnsiString;
|
||||
n: Integer;
|
||||
buf: AnsiString;
|
||||
sent, n: Integer;
|
||||
begin
|
||||
if FSocket = SOCK_INVALID then Exit;
|
||||
buf := AnsiString(S);
|
||||
if Length(buf) = 0 then Exit;
|
||||
{$IFDEF MSWINDOWS}
|
||||
n := send(FSocket, buf[1], Length(buf), 0);
|
||||
if n = SOCKET_ERROR then begin
|
||||
{$ELSE}
|
||||
n := fpSend(FSocket, @buf[1], Length(buf), 0);
|
||||
if n <= 0 then begin
|
||||
{$ENDIF}
|
||||
FMarkDelete := True;
|
||||
Terminate;
|
||||
sent := 0;
|
||||
while sent < Length(buf) do
|
||||
begin
|
||||
{$IFDEF MSWINDOWS}
|
||||
n := send(FSocket, buf[sent + 1], Length(buf) - sent, 0);
|
||||
if n = SOCKET_ERROR then n := -1;
|
||||
{$ELSE}
|
||||
n := fpSend(FSocket, @buf[sent + 1], Length(buf) - sent, 0);
|
||||
{$ENDIF}
|
||||
if n <= 0 then
|
||||
begin
|
||||
FMarkDelete := True;
|
||||
Terminate;
|
||||
Exit;
|
||||
end;
|
||||
Inc(sent, n);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Reference in New Issue
Block a user