Чтение и запись СОМ-порта

function TForm1.ReadPort(var Buf; Size: Word): Integer;
var i: Cardinal;
    ovr: TOverlapped;
begin
  FillChar(Buf, Size, 0);
  FillChar(ovr, SizeOf(ovr), 0);
  i := 0;
  Result := -1;
  if not Windows.ReadFile(Com, Buf, Size, i, @ovr) then exit;
  Result := i;
end;
 
function TForm1.WritePort(var Buf; Size: Word): Integer;
var p: Pointer;
    i: Cardinal;
begin
  p := @Buf;
  Result := 0;
  while Size > 0 do
    begin
      if not WriteFile(Com, p^, 1, i, nil) then exit;
      Inc(Result, i);
      Inc(Integer(p));
      Dec(Size);
      Application.ProcessMessages;
    end;
end;

type
  TCommThread = class(TThread)//Объявляем поток
  private
    { Private declarations }
    Procedure QueryPort;//Прерывание порта
  public
    { Public declarations }
protected
     Procedure Execute; override;// Процедура запуска потока 
  end;
 
var
  Form1: TForm1;
  ComFile:THandle;
  CommTimeouts: TCommTimeouts;
  CommThread:TCommThread;
  BytesRead: DWORD;
  b:char;
  all_buf:string;
  DCB:TDCB;
 
implementation
 
{$R *.dfm}
Procedure StartComThread;
Begin
CommThread:=TCommThread.Create(False);//Создаем поток
CommThread.Priority:=tpHighest;
If CommThread = Nil Then
Begin
SysErrorMessage(GetLastError);
Exit;
End;
End;
 
Procedure TCommThread.QueryPort;// Прослушивание порта на наличие данных точнее заполнен ли 
//буфер
Var MyBuff:array [1..26] of Char;
Begin
FillChar(MyBuff,SizeOf(MyBuff),#0);
ReadFile(ComFile,MyBuff,SizeOf(MyBuff),BytesRead,Nil);
If Not ReadFile(ComFile,MyBuff,SizeOf(MyBuff),BytesRead,Nil) Then
Begin
SysErrorMessage(GetLastError);
CloseHandle(ComFile);
Exit;/End;
If BytesRead>0 Then
Begin
all_buf:=all_buf+(MyBuff);
Form1.Memo1.Lines.Add(all_buf);
exit;
End;
End;
 
procedure TCommThread.Execute;
begin
 Repeat
  QueryPort;
 Until Terminated;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
ComFile:=CreateFile('com4',GENERIC_READ,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_READONLY,0);
if ComFile=INVALID_HANDLE_VALUE then begin
    ShowMessage('Не удалось открыть порт ');
 exit;
end;
SetupComm(ComFile,4096,4096);
GetCommState(ComFile,DCB);
with DCB do begin
    BaudRate:=38400;
    ByteSize:=8;
    Parity:=NoParity;
    StopBits:=OneStopBit;
end;
if not SetCommState(ComFile,DCB) then begin
    ShowMessage('Порт не настроен');
    CloseHandle(ComFile);
    exit;
end;
StartComThread;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
OutputBuffer: array [0..1] of Char;  // выходной буфер
ErrorCode: integer; 
begin
  OutputBuffer[0]:='A'; 
  OutputBuffer[1]:='1'; 
  ErrorCode:=Writeport(OutputBuffer,Length(OutputBuffer));  // передача пакета
  if ErrorCode > 0 then MessageDlg('Пакет передан', MtConfirmation, [mbOK], 0)
  else MessageDlg('Ошибка передачи пакета', MtWarning, [mbOK], 0);
end;
 
----------------------------------------------------------------------------
function TForm1.WritePort(var Buf; Size: Word): Integer;
var
  p: Pointer;
  i: Cardinal;
begin
  p:=@Buf;
  Result:= 0;
  while Size > 0 do
  begin
      if not WriteFile(Comfile, p^, 1, i, nil) then
        exit;
        Inc(Result, i);
        Inc(Integer(p));
        Dec(Size);
        Application.ProcessMessages;
  end;
end;
-------------------------------------------------------