From 20bf3c1f39ecc25366b2900cf095c7e587f92cc5 Mon Sep 17 00:00:00 2001 From: Uladzimir Karpenka Date: Mon, 17 Aug 2026 13:13:46 +0300 Subject: [PATCH] =?UTF-8?q?fix(cat):=20=D1=82=D1=80=D0=B0=D0=BD=D1=81?= =?UTF-8?q?=D0=BF=D0=BE=D1=80=D1=82=D1=8B=20=E2=80=94=20=D0=BA=D0=BE=D1=80?= =?UTF-8?q?=D0=BE=D1=82=D0=BA=D0=B0=D1=8F=20=D0=B7=D0=B0=D0=BF=D0=B8=D1=81?= =?UTF-8?q?=D1=8C=20=D0=B2=20TCP=20=D0=B8=20=D0=BC=D0=BE=D0=BB=D1=87=D0=B0?= =?UTF-8?q?=D0=BB=D0=B8=D0=B2=D1=8B=D0=B9=20=D0=BE=D1=82=D0=BA=D0=B0=D0=B7?= =?UTF-8?q?=20serial-=D0=BF=D0=BE=D1=80=D1=82=D0=B0?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit CATTcp.SendStr делал один send на ответ. TCP не обязан отдавать весь буфер за раз, а усечение здесь не ошибка — длинный ответ (IF, ZZEB, список режимов) мог уехать обрезанным, и молча. Дописываем остаток в цикле. CATSerial помечал порт активным ДО SerOpen, а открытие шло внутри потока: при отказе порт навсегда оставался «работающим» в ActiveCount и UI, а причина нигде не оседала. Открытие переехало в TCATSerialPort.Start и делается синхронно, так что отказ виден сразу — FActive остаётся False, причина в новом свойстве LastError. Поток теперь только читает, закрывает владелец в Stop. Заодно Andromeda-порт назначался по галке в настройках, без оглядки на то, поднялся ли порт: HasAndromeda рапортовал о панели, которой нет. Co-Authored-By: Claude Opus 5 --- CATSerial.pas | 121 +++++++++++++++++++++++++++++--------------------- CATTcp.pas | 32 ++++++++----- 2 files changed, 91 insertions(+), 62 deletions(-) diff --git a/CATSerial.pas b/CATSerial.pas index 3eca08a..4385321 100644 --- a/CATSerial.pas +++ b/CATSerial.pas @@ -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; diff --git a/CATTcp.pas b/CATTcp.pas index 640a223..0f2a2cc 100644 --- a/CATTcp.pas +++ b/CATTcp.pas @@ -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;