Я написал класс последовательного порта, который я разработал, и для простоты я использовал блокировку / синхронный / без перекрытия .Я просмотрел всю документацию 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;
Моя проблема начинается с закрытия порта.После всех моих сообщений, когда я пытаюсь закрыть последовательный порт, мое приложение полностью зависает в API CloseHandle ().И это происходит случайно .Что для меня бессмысленно, так как я использую синхронный режим, не может быть никаких ожидающих операций.Когда я запрашиваю закрытие, он должен просто закрыть дескриптор.
Я искал проблему в Google и переполнении стека.Есть много людей, которые сталкивались с подобными проблемами, но большинство из них связано с драйвером последовательного порта .NET и их операциями асинхронного режима, которых у меня нет.
А также некоторые люди забыли правильно установить время ожидания, и онистолкнулся с проблемой блокировки в ReadFile и WriteFile API, которая является полностью нормальной.Но опять же, это не моя проблема, я установил CommTimeouts, как указано в комментариях MSDN.
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;
Некоторые люди на форуме Microsoft предлагают вызывать 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;
В моем ноутбуке я использую преобразователи USB в последовательный порт из FTDI.Некоторые люди говорили, что это из-за драйвера FTDI.Но я использую все драйверы Microsoft, которые подписаны Microsoft Windows Hardware Compatibility Publisher.В моей системе нет стороннего драйвера.Но когда я отключаю USB-адаптер, API CloseHandle размораживается.Некоторые люди сообщают, что даже родные последовательные порты, встроенные в их материнские платы, имеют ту же проблему.
До сих пор я не мог решить эту проблему.Любая помощь или обходной путь высоко ценится.
Спасибо.