unit Comm;
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Forms;

type
  TCommEvent = procedure(Sender: TObject; Data: Char) of object;
  TCommErrEvent = procedure(Sender: TObject; Error: Integer) of object;
  TComm = class(TComponent)
  private
    Wnd: HWND;
    DCB: TDCB;
    CommID: Integer;
    Buf: array[0..2048] of char;
    NumChars: Integer;
    FOnCommErr: TCommErrEvent;
    FOnCommRecvd: TCommEvent;
    procedure CommWndProc(var Message: TMessage);
  public
    function Send(data: Char): Boolean;
    function Connect: Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor destroy; override;
  published
    property OnCommErr: TCommErrEvent read FOnCommErr write FOnCommErr;
    property OnCommRecvd: TCommEvent read FOnCommRecvd write FOnCommRecvd;
  end;
procedure Register;
implementation

constructor TComm.Create(AOwner: TComponent);
begin

  inherited Create(AOwner);
  Wnd := AllocateHwnd(CommWndProc);
end;

procedure TComm.CommWndProc(var Message: TMessage);
var

  Error, count: Integer;
  Stat: TComStat;
begin

  if Message.Msg = WM_COMMNOTIFY then
  begin
    Message.Result := 0;
    GetCommEventMask(CommId, $3FFF);
    NumChars := ReadComm(CommID, @Buf, 2048);
    Error := GetCommError(CommId, Stat);
    if Error = 0 then
    begin
      if Assigned(FOnCommRecvd) then
      begin
        for count := 0 to NumChars - 1 do
          FOnCommRecvd(Self, Buf[count]);
      end;
    end
    else
    begin
      if Assigned(FOnCommErr) then
      begin
        FOnCommErr(Self, Error);
      end;
    end;
  end;
end;

function TComm.Send(data: Char): Boolean;
var

  Error: Integer;
begin

  Error := TransmitCommChar(CommId, data);
  if Error < 0 then
    Result := False
  else
    Result := True;
end;

function TComm.Connect: Boolean;
var

  Config: array[0..20] of Char;
begin

  CommId := OpenComm('COM2', 2048, 2048);
  StrCopy(Config, 'com2:96,n,8,1'); {Здесь меняем настройки порта}
  BuildCommDCB(Config, DCB);
  DCB.ID := CommId;
  SetCommState(DCB);
  EnableCommNotification(CommID, Wnd, 1, -1);
  SetCommEventMask(CommId, ev_RXChar);
  Result := True;
end;

destructor TComm.destroy;
begin

  CloseComm(CommID);
  DeallocateHwnd(Wnd);
  inherited destroy;
end;

procedure Register;
begin

  RegisterComponents('Samples', [TComm]);
end;
end.