unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Spin, Mask;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    CheckBox2: TCheckBox;
    Button1: TButton;
    Button2: TButton;
    ComboBox1: TComboBox;
    MaskEdit3: TMaskEdit;
    MaskEdit1: TMaskEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListBox1DblClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure MaskEdit3KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 procedure WorkComm;

var
  Form1: TForm1;
  COMport,temp:dword;
  overlapped : TOverlapped;
  Bufrd,bufwd : array [0..255] of byte;
  bufer: array of byte;
  CommThread : THandle;
  p:boolean;


implementation

{$R *.dfm}
procedure WorkComm;
var
  s:string;
  i,corsumm:byte;
  btr,  mask, signal:dword;
  comstat : TComStat;
begin
 overlapped.hEvent:= CreateEvent(NiL, true, true, NiL);	//создать сигнальный объект-событие для асинхронных операций
 while true do						//пока поток не будет прерван, выполняем цикл
  begin
   randomize;
   WaitCommEvent(COMport, mask, @overlapped);               	//ожидать события приёма байта (это и есть перекрываемая операция)
   signal:= WaitForSingleObject(overlapped.hEvent, INFINITE);	//приостановить поток до прихода байта
   if(signal = WAIT_OBJECT_0)	then			        //если событие прихода байта произошло
     if(GetOverlappedResult(COMport, overlapped, temp, true)) then //проверяем, успешно ли завершилась перекрываемая операция WaitCommEvent
      if((mask and EV_RXCHAR) <> 0)	then				//если произошло именно событие прихода байта
        begin
          ClearCommError(COMport, temp, @comstat);		//нужно заполнить структуру COMSTAT
          btr:= comstat.cbInQue;                          	//и получить из неё количество принятых байтов
          if btr <>0  then                         			//если действительно есть байты для чтения
          begin
           ReadFile(COMport, bufrd, btr, temp, @overlapped);     //прочитать байты из порта в буфер программы
           s:='';
           for i:=0 to btr-1 do
              s:=s + ' ' + inttohex(bufrd[i],2);
           form1.ListBox1.Items.Add(s);
           if form1.CheckBox2.Checked then
             form1.ListBox1.ItemIndex:=form1.ListBox1.Count-1;
          end;
        end;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TerminateThread(CommThread,0);
  CloseHandle(COMport);
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
ListBox1.Items.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ThreadId : DWord;
  TimeOuts : TCommTimeouts;
   dcb: TDCB;                //структура для общей инициализации порта DCB
begin
  TerminateThread(CommThread,0);
  CloseHandle(COMport);
 sleep(100);

 COMport:= CreateFile(pchar(ComboBox1.Text),GENERIC_READ or GENERIC_WRITE, 0, NiL, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
 //==========
 dcb.DCBlength:= sizeof(DCB); 	//в первое поле структуры DCB необходимо занести её длину, она будет использоваться функциями настройки порта для контроля корректности структуры

 GetCommState(COMport, dcb);
 dcb.BaudRate:= 9470;       //задаём скорость передачи 115200 бод
 dcb.ByteSize := 8;                                      //задаём 8 бит в байте
 dcb.Parity := 0;                                        //отключаем проверку чётности
 dcb.StopBits := 0;                                      //задаём один стоп-бит
 SetCommState(COMport, dcb);
 //=========
 timeouts.ReadIntervalTimeout := 0;	 	//таймаут между двумя символами
 timeouts.ReadTotalTimeoutMultiplier := 0;	//общий таймаут операции чтения
 timeouts.ReadTotalTimeoutConstant := 0;         //константа для общего таймаута операции чтения
 timeouts.WriteTotalTimeoutMultiplier := 0;      //общий таймаут операции записи
 timeouts.WriteTotalTimeoutConstant := 0;        //константа для общего таймаута операции записи
 SetCommTimeouts(COMport, timeouts);
 //==========
 SetCommMask(COMport,EV_RXCHAR);
 SetupComm(COMport,2000,2000);

 PurgeComm(COMport, PURGE_RXCLEAR);	//очистить принимающий буфер порта

  //стартуем дочерний поток, функция потока - WorkComm
    CommThread := CreateThread(nil,0,@WorkComm,nil,0,ThreadID);
  //  SetThreadPriority(CommThread,8);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    bufwd[0]:=$20;
    bufwd[1]:=$05;
    bufwd[2]:=strtoint(tedit(MaskEdit3).Text);
    bufwd[3]:=strtoint(tedit(MaskEdit1).Text);
    BufWd[4]:=-(bufwd[0]+bufwd[1]+bufwd[2]+bufwd[3]);
    WriteFile(COMport, bufwd, 5, temp, @overlapped);
end;

procedure TForm1.MaskEdit3KeyPress(Sender: TObject; var Key: Char);
begin
    if not (key in (['0'..'9']+['a'..'f']+['A'..'F'])) and (ord(key) <> VK_BACK) then
        key := #0;
end;

end.
