Архив исходников программ, модулей и компонентов на Delphi


Начальная страница

Поиск по базе



Операционная система
Настройка приложения
Взаимодействия приложений
Файлы и директории
Строки и символы
Математика
Базы данных
Интернет и сеть
Мультимедиа
Аппаратная часть
VCL
Другие разделы [0]
 

Количество записей в базе - 537
Сегодня добавлено – 0

Системные устройства



Вернуться к списку функций
 Com порт - Асинхронная работа

 Прислал: Igor Pavlov, Mukovoz IL'ya ( 30 июля 2003 г. )
©  (c) 2003, Igor Pavlov
 Описание:
Клас позволяет работать в асинхронном режиме с COM портом
// Class: TComPort
// Description: Asynchronous (overlapped) COM port
// Version: 1.0
// Date: 10-Jun-2003
// Author: Igor Pavlov, pavlov_igor@nm.ru
// Copyright: (c) 2003, Igor Pavlov
// *****************************************
// Edited and putched
// Date: 01/07/2003
// Author: Mukovoz IL'ya Sergeevich, nuclear@bel.ru

 Зависимости:
SysUtils, Windows, Variants, Classes, Dialogs

 Ограничения:
D6, winXP

 Исходный текст:
{ **** UBPFD *********** by http://kladovka.net.ru/delphibase/ ****
>> Com порт - Асинхронная работа

Клас позволяет работать в асинхронном режиме с COM портом
// Class: TComPort
// Description: Asynchronous (overlapped) COM port
// Version: 1.0
// Date: 10-Jun-2003
// Author: Igor Pavlov, pavlov_igor@nm.ru
// Copyright: (c) 2003, Igor Pavlov
// *****************************************
// Edited and putched
// Date: 01/07/2003
// Author: Mukovoz IL'ya Sergeevich, nuclear@bel.ru

Зависимости: SysUtils, Windows, Variants, Classes, Dialogs
Автор:       Igor Pavlov, Mukovoz IL'ya, pavlov_igor@nm.ru, nuclear@bel.ru, ICQ:126654980
Copyright:   (c) 2003, Igor Pavlov
Дата:        30 июля 2003 г.
***************************************************************** }

unit ComPort;

////////////////////////////////////////////////////////////////////////////////
// //
// Class: TComPort //
// //
// Description: Asynchronous (overlapped) COM port //
// Version: 1.0 //
// Date: 10-Jun-2003 //
// Author: Igor Pavlov, pavlov_igor@nm.ru //
// //
// Copyright: (c) 2003, Igor Pavlov //
// //
////////////////////////////////////////////////////////////////////////////////

//*******************************************************************************
// *
// Edited and putched *
// *
// Date: 01/07/2003 *
// Author: Mukovoz IL'ya Sergeevich, nuclear@bel.ru *
// *
//*******************************************************************************

interface

uses
  SysUtils, Windows, Variants, Classes, Dialogs;

type
  EComPortError = class(Exception);

  TBaudRate = (br110 = CBR_110,
               br300 = CBR_300,
               br600 = CBR_600,
               br1200 = CBR_1200,
               br2400 = CBR_2400,
               br4800 = CBR_4800,
               br9600 = CBR_9600,
               br14400 = CBR_14400,
               br19200 = CBR_19200,
               br38400 = CBR_38400,
               br56000 = CBR_56000,
               br57600 = CBR_57600,
               br115200 = CBR_115200,
               br128000 = CBR_128000,
               br256000 = CBR_256000);

  TComPort = class;

  {Reading thread}
  TReadThread = class(TThread)
  private
    FBuf: array[0..$FF] of Byte;
    FComPort: TComPort;
    FOverRead: TOverlapped;
    FRead: DWORD;
    procedure DoRead;
  protected
    procedure Execute; override;
  public
    constructor Create(ComPort: TComPort);
    destructor Destroy; override;
  end;

  {Reading event}
  TReadEvent = procedure(Sender: TObject; ReadBytes: array of Byte) of object;

  {Com port class}
  TComPort = class
  private
    FOverWrite: TOverlapped;
    FPort: THandle;
    FPortName: String;
    FReadEvent: TReadEvent;
    FReadThread: TReadThread;
  public
    constructor Create(PortNumber: Cardinal; BaudRate: TBaudRate);
    destructor Destroy; override;
    procedure Write(WriteBytes: array of Byte);
  published
    property OnRead: TReadEvent read FReadEvent write FReadEvent;
    property PortName: String read FPortName;
  end;

implementation

constructor TReadThread.Create(ComPort: TComPort);
begin
  FComPort := ComPort;
  ZeroMemory(@FOverRead, SizeOf(FOverRead));

  {Event}
  FOverRead.hEvent := CreateEvent(nil, True, False, nil);

  if FOverRead.hEvent = Null then
    raise EComPortError.Create('Error creating read event');

  inherited Create(False);
end;

destructor TReadThread.Destroy;
begin
  CloseHandle(FOverRead.hEvent);

  inherited Destroy;
end;

procedure TReadThread.Execute;
var
  ComStat: TComStat;
  dwMask, dwError: DWORD;
begin
  FreeOnTerminate := True;

  while not Terminated do
  begin
    if not WaitCommEvent(FComPort.FPort, dwMask, @FOverRead) then
    begin
      if GetLastError = ERROR_IO_PENDING then
        WaitForSingleObject(FOverRead.hEvent, INFINITE)
      else
        raise EComPortError.Create('Error waiting port ' + FComPort.PortName
          + ' event');
    end;
    if not Terminated then
      if not ClearCommError(FComPort.FPort, dwError, @ComStat) then
        raise EComPortError.Create('Error clearing port ' + FComPort.PortName);

    FRead := ComStat.cbInQue;

    if FRead > 0 then
    begin
      if not ReadFile(FComPort.FPort, FBuf, FRead, FRead, @FOverRead) then
        raise EComPortError.Create('Error reading port ' + FComPort.PortName);

      Synchronize(DoRead);
    end;
  end; {while}
end;

procedure TReadThread.DoRead;
var
  arrBytes: array of Byte;
  i: Integer;
begin
  if Assigned(FComPort.FReadEvent) then
  begin
    SetLength(arrBytes, FRead);
    for i := Low(FBuf) to FRead - 1 do
      arrBytes[i] := FBuf[i];

    FComPort.FReadEvent(Self, arrBytes);

    arrBytes := nil;
  end;
end;

constructor TComPort.Create(PortNumber: Cardinal; BaudRate: TBaudRate);
var
  Dcb: TDcb;
begin
  inherited Create;

  ZeroMemory(@FOverWrite, SizeOf(FOverWrite));
  FPortName := 'COM' + IntToStr(PortNumber);

  {Open port}
  FPort := CreateFile(PChar(PortName),
    GENERIC_READ or GENERIC_WRITE, 0, nil,
    OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);

  if FPort = INVALID_HANDLE_VALUE then
    raise EComPortError.Create('Error opening port ' + PortName);

  try
    {Set port state}
    if not GetCommState(FPort, Dcb) then
      raise EComPortError.Create('Error setting port ' + PortName + ' state');

    Dcb.BaudRate := DWORD(BaudRate);
    Dcb.Parity := NOPARITY;
    Dcb.ByteSize := 8;
    Dcb.StopBits := ONESTOPBIT;

    if not SetCommState(FPort, Dcb) then
      raise EComPortError.Create('Error setting port ' + PortName + ' state');

    {Purge port}
    if not PurgeComm(FPort, PURGE_TXCLEAR or PURGE_RXCLEAR) then
      raise EComPortError.Create('Error purging port ' + PortName);

    {Set mask}
    if not SetCommMask(FPort, EV_RXCHAR) then
      raise EComPortError.Create('Error setting port ' + PortName + ' mask');

    FOverWrite.hEvent := CreateEvent(nil, True, False, nil);

    if FOverWrite.hEvent = Null then
      raise EComPortError.Create('Error creating write event');

    {Reading thread}
    FReadThread := TReadThread.Create(Self);
  except
    CloseHandle(FOverWrite.hEvent);
    CloseHandle(FPort);
    raise;
  end;
end;

destructor TComPort.Destroy;
begin
  if Assigned(FReadThread) then
    FReadThread.Terminate;
    
  CloseHandle(FOverWrite.hEvent);
  CloseHandle(FPort);

  inherited Destroy;
end;

procedure TComPort.Write(WriteBytes: array of Byte);
var
  dwWrite: DWORD;
begin
    if (not WriteFile(FPort, WriteBytes, SizeOf(WriteBytes), dwWrite, @FOverWrite))
    and (GetLastError <> ERROR_IO_PENDING) then
      raise EComPortError.Create('Error writing port ' + PortName);
end;

end.

 Пример использования:
type
  ...
  procedure OnRead(Sender: TObject; ReadBytes: array of Byte);
  ...
  private
    { Private declarations }
    Port: TComPort;

procedure TfrmMain.btnOpenClick(Sender: TObject);
begin
  Port := TComPort.Create(udnPort.Position, br9600);
  Port.OnRead := OnRead;
end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
  Port.Free;
end;

procedure TfrmMain.OnRead(Sender: TObject; ReadBytes: array of Byte);
var
  i: Integer;
  TmpStr : string;
begin
  TmpStr := '';
  for i := Low(ReadBytes) to High(ReadBytes) do
  begin
    if i > Low(ReadBytes) then
    TmpStr := TmpStr + IntToHex(ReadBytes[i], 2);
  end;
  ShowMessage(TmpStr);
end;

procedure TfrmMain.btnWriteClick(Sender: TObject);
var
  strWrite: string;
  arrBytes: array of Byte;
  i: Integer;
begin
    strWrite := edtWrite.Text;
    SetLength(arrBytes, Length(strWrite));
    for i := Low(arrBytes) to High(arrBytes) do
      arrBytes[i] := Ord(strWrite[i + 1]);
    Port.Write(arrBytes);
    arrBytes := nil;
end;


Вернуться к списку функций

Наверх ▲