Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 8 октября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Работа с последовательными портами 2

Если вам нужно что-то РЕАЛЬНОЕ, то попробуйте это. Можете только добавить проверку на ошибки.

<<Книги>> Serial Communications: A C++ Developer's Guide by Mark Nelson, M&T Books.

Правда, по большей части это про DOS, а Windows посвящена только одна глава. Проверьте это.


 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.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS