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. 