非重叠串行端口挂在 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://learn.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 调用中的重叠结构中获取完成事件后使用 SETRTS 调用该异步。

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

需要记住的一件事是，某些 USB 串行设备（甚至不同版本的 FTDI）可能会反转 RTS 线路！因此，如果上述方法不起作用，请尝试使用 SETRTS 将线路设置为低电平，并使用 CLRRTS 将其设置为高电平。

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