非重叠串行端口在 CloseHandle 处挂起

Question

我编写了一个自己开发的串行端口类，为了简单起见，我使用了阻塞/同步/非重叠。我浏览了所有 MSDN 文档，这对我来说很困难。

从端口打开、传输或接收字节没有任何问题。所有操作都是同步的，没有线程复杂性。

function TSerialPort.Open: Boolean;
var
  h: THandle;
  port_timeouts: TCommTimeouts;
  dcb: TDCB;
begin
  Result := False;

  if Assigned(FHandleStream) then
  begin
    // already open
    Exit(True);
  end;

  h := CreateFile(PChar('\\?\' + FComPort),
                  GENERIC_WRITE or GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

  // RaiseLastOSError();
  if h <> INVALID_HANDLE_VALUE then
  begin
    {
      REMARKS at https://docs.microsoft.com/en-us/windows/desktop/api/winbase/ns-winbase-_commtimeouts
      If an application sets ReadIntervalTimeout and ReadTotalTimeoutMultiplier to MAXDWORD and
      sets ReadTotalTimeoutConstant to a value greater than zero and less than MAXDWORD, one
      of the following occurs when the ReadFile function is called:

      * If there are any bytes in the input buffer, ReadFile returns immediately with the bytes in the buffer.
      * If there are no bytes in the input buffer, ReadFile waits until a byte arrives and then returns immediately.
      * If no bytes arrive within the time specified by ReadTotalTimeoutConstant, ReadFile times out.
    }

    FillChar(port_timeouts, Sizeof(port_timeouts), 0);
    port_timeouts.ReadIntervalTimeout := MAXDWORD;
    port_timeouts.ReadTotalTimeoutMultiplier := MAXDWORD;
    port_timeouts.ReadTotalTimeoutConstant := 50; // in ms
    port_timeouts.WriteTotalTimeoutConstant := 2000; // in ms

    if SetCommTimeOuts(h, port_timeouts) then
    begin
      FillChar(dcb, Sizeof(dcb), 0);
      dcb.DCBlength := sizeof(dcb);

      if GetCommState(h, dcb) then
      begin
        dcb.BaudRate := FBaudRate;                            //  baud rate
        dcb.ByteSize := StrToIntDef(FFrameType.Chars[0], 8);  //  data size
        dcb.StopBits := ONESTOPBIT;                           //  1 stop bit
        dcb.Parity   := NOPARITY;
        case FFrameType.ToUpper.Chars[1] of
          'E': dcb.Parity   := EVENPARITY;
          'O': dcb.Parity   := ODDPARITY;
        end;

        dcb.Flags := dcb_Binary or dcb_Parity or dcb_ErrorChar or
                     (DTR_CONTROL_ENABLE shl 4) or (RTS_CONTROL_ENABLE shl 12);

        dcb.ErrorChar := '?'; // parity error will be replaced with this char

        if SetCommState(h, dcb) then
        begin
          FHandleStream := THandleStream.Create(h);
          Result := True;
        end;
      end;
    end;

    if not Result then
    begin
      CloseHandle(h);
    end;
  end;
end;

function TSerialPort.Transmit(const s: TBytes): Boolean;
var
  len: NativeInt;

begin
  Result := False;
  len := Length(s);

  if Assigned(FHandleStream) and (len > 0) then
  begin
    // total timeout to transmit is 2sec!!
    Result := (FHandleStream.Write(s, Length(s)) = len);
  end;
end;

function TSerialPort.Receive(var r: Byte): Boolean;
begin
  Result := False;

  if Assigned(FHandleStream) then
  begin
    // read timeout is 50ms
    Result := (FHandleStream.Read(r, 1) = 1);
  end;
end;

我的问题始于关闭端口。 经过我所有的通信，当我尝试关闭串行端口时，我的应用程序完全挂在 CloseHandle() API 上。这会随机发生。这对我来说毫无意义，因为我使用同步模式，不能有任何挂起的操作。当我请求关闭时，它必须简单地关闭句柄。

我在 google 和 stack-overflow 上搜索了这个问题。有很多人遇到过类似的问题，但大部分都与.NET串口驱动和异步模式操作有关，我没有。

还有一些人忘记正确设置超时，他们在 ReadFile 和 WriteFile API 上遇到阻塞问题，这是完全正常的。但这又不是我的问题，我已经按照 MSDN 备注中的说明设置了 CommTimeouts。

function TSerialPort.Close: Boolean;
var
  h: THandle;

begin
  Result := True;

  if Assigned(FHandleStream) then
  begin
    h := FHandleStream.Handle;
    FreeAndNil(FHandleStream);

    if h <> INVALID_HANDLE_VALUE then
    begin
      //PurgeComm(h, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR); // didn't help
      //ClearCommError(h, PDWORD(nil)^, nil);  // didn't help
      //CancelIO(h);  // didn't help
      Result := CloseHandle(h); <------------ hangs here
    end;
  end;
end;

微软论坛上的一些人，建议在不同的线程中调用 CloseHandle()。我也试过了。但是那一次它在尝试释放我创建的 AnonymousThread 时挂起。即使我将 FreeOnTerminate:=true 保留为默认值，它也会挂起，并且我得到 Delphi 的内存泄漏报告。

当它挂起时另一个令人烦恼的问题是，我必须完全关闭 Delphi IDE 并重新打开。否则我无法再次编译代码，因为仍然使用 exe。

function TSerialPort.Close: Boolean;
var
  h: THandle;
  t: TThread;
  Event: TEvent;

begin
  Result := True;

  if Assigned(FHandleStream) then
  begin
    h := FHandleStream.Handle;
    FreeAndNil(FHandleStream);

    if h <> INVALID_HANDLE_VALUE then
    begin
      PurgeComm(h, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
      Event := TEvent.Create(nil, False, False, 'COM PORT CLOSE');
      t := TThread.CreateAnonymousThread(
        procedure()
        begin
          CloseHandle(h);
          If Assigned(Event) then Event.SetEvent();
        end);

      t.FreeOnTerminate := False;
      t.Start;
      Event.WaitFor(1000);
      FreeAndNil(t);  // <---------- that time it hangs here, why??!!
      FreeAndNil(Event);
    end;
  end;
end;

在我的笔记本中，我使用的是 FTDI 的 USB 转串口转换器。有人说是因为FTDI驱动。但我使用的是由 Microsoft Windows Hardware Compatibility Publisher 签名的所有 Microsoft 驱动程序。我的系统中没有第三方驱动程序。但是当我断开 USB 适配器时，CloseHandle API 会自行解冻。有人报告说，即使是主板内置的原生串行端口也有同样的问题。

到目前为止，我无法解决问题。非常感谢任何帮助或解决方法。

谢谢。

Answer 1

此问题与 FTDI USB 串行转换器驱动程序有关。它不能正确处理硬件流控制，有时会在 CloseHandle 调用中挂起。

要解决此问题，请手动实施硬件流控制。在 C++ 中（不确定如何在 Delphi 中完成）设置这些 DCB 结构字段以允许手动控制 RTS 行：

// Assuming these variables are defined in the header
HANDLE m_hComm; // Comm port handle.
DCB m_dcb;      // DCB comm port settings.

// Put these settings in the DCB structure.
m_dcb.fRtsControl = RTS_CONTROL_ENABLE;
m_dcb.fOutxCtsFlow = TRUE;

然后使用

EscapeCommFunction(m_hComm, CLRRTS); // Call this before calling WriteFile.

和

EscapeCommFunction(m_hComm, SETRTS); // Call this after Write is complete.

在你的情况下，因为它是同步的——你可以用这两个调用来包装对 WriteFile 的每个调用。如果使用异步（如我的情况），请在从 WriteFile 调用中的重叠结构中获取完成事件后使用 SERTTS 调用。

在我们使用 12 个串行端口之前一直冻结，因为我们使用 12 个串行端口，解锁端口的唯一方法是重新启动计算机。 现在就像一个手动控制的魅力，从那以后就再也没有冻结过。

请记住，某些 USB 串行设备（甚至不同版本的 FTDI）可能会反转 RTS 线路！所以如果上述方法不起作用，请尝试使用 SERTTS 将线路设置为低，并使用 CLRRTS 将其设置为高。

编辑：如果您可以访问 Windows XP 机器，请使用 portmon 工具查看 RTS 行发生了什么，这样您就可以知道它是否被反转或者它是否正在获取命令。