Форум программистов [Powered by Invision Power Board]

Код

procedure TbtkSerialPortReaderThread.Execute;
var
  dwMask, dwTemp: DWORD;
  signal : Cardinal;
  r: integer;
begin
  FillChar(FOverlap,SizeOf(TOverlapped),0);
  try
    FOverlap.hEvent := CreateEvent(nil, true, true, nil);
    if FOverlap.hEvent = 0 then
      raise EComPortException.Create('Îøèáêà ñîçäàíèÿ ñîáûòèÿ íà ÷òåíèå èç COM ïîðòà', FComPort.PortName);

    r := integer(SetCommMask(FComPort.FPortHandle, EV_RXCHAR or EV_BREAK)); //
    if r = 0 then
      RaiseLastWin32Error;

    ClearCommBreak(FComPort.FPortHandle);
    PurgeComm(FComPort.FPortHandle, PURGE_RXABORT or PURGE_RXCLEAR);

    while not Terminated do
    begin
       if not WaitCommEvent(FComPort.FPortHandle, dwMask, @FOverlap) then
      begin
       if GetLastError <> ERROR_IO_PENDING then
          raise Exception.Create('Error waiting port event');
      end;
      signal := WaitForSingleObject(FOverlap.hEvent, INFINITE); \\ Не задерживается
      if (signal = WAIT_OBJECT_0) and not Terminated then
      begin
        if GetOverlappedResult(FComPort.FPortHandle, FOverlap, dwTemp, true)then
        begin
          if((dwMask and EV_RXCHAR)<> 0)    then
          begin
             FComPort.PortData := FComPort.ReadPort(FOverlap);
             DataReadedEvent;
             WaitForSingleObject(FEvent, INFINITE);
             ResetEvent(FEvent);
          end;
        end;
      end;
    end;
  except
    FException := ExceptObject as Exception;
    ProcessException;
  end;
end;

function TbtkSerialPort.ReadPort(var AOverlapped: TOverlapped): string;
var
  byteCount, Errs: DWORD;
  stat: TComStat;
  p: PChar;
  Buff: array of byte;
begin

  ClearCommError(FPortHandle,errs,@stat);
  if errs <> 0 then
     RaiseLastWin32Error;
  byteCount := Stat.cbInQue;   //0
  // 1 - место под символ конца строки
  SetLength(Buff, byteCount+1);
  try
    FillChar(Buff[0], byteCount+1, #0);
    ReadFile(FPortHandle, Buff[0], byteCount, byteCount, @AOverlapped);
    if ByteCount > 0 then //÷òî-òî ïðèøëî
      Result := String(Buff)
    else
      Result := '';
  finally
    SetLength(Buff, 0);
  end;
end;