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;