interface ...
type
 TComPort = class;
 EComPortError = class(Exception);
 {поток чтения}
 TReadThread = class(TThread)
 private
   FBuf: array [0..100000] of byte;
   FComPort: TComPort;
   FOverRead: TOverlapped;
   FRead: DWORD;
   procedure DoRead;
 protected
   procedure Execute; override;
 public
   constructor Create(ComPort: TComPort);
   destructor Destroy; override;
 end;
 TReadEvent = procedure(Sender: TObject; ReadBytes: array of byte) of object;

 TComPort = class
 private
   FOverWrite: TOverlapped;
   FPort: THandle;
   FPortName: String;
   FReadEvent: TReadEvent;
   FReadThread: TReadThread;
 public
   constructor Create(PortNumber: Cardinal; dcb: Tdcb);
   destructor Destroy; override;
   procedure Write(WriteBytes: array of Byte);
 published
   property OnRead: TReadEvent read FReadEvent write FReadEvent;
   property PortName: String read FPortName;
 end;

implementation

constructor TReadThread.Create(ComPort: TComPort);
begin
 FComPort := ComPort;
 ZeroMemory(@FOverRead, SizeOf(FOverRead));
 FOverRead.hEvent := CreateEvent(nil, True, False, nil);
 if FOverRead.hEvent = Null then raise EComPortError.Create('Error creating read event');
 inherited Create(False);
end;

destructor TReadThread.Destroy;
begin
 CloseHandle(FOverRead.hEvent);
 inherited Destroy;
end;

procedure TReadThread.Execute
var ComStat: TComStat;
   dwMask, dwError,dwRead: DWORD;
begin
  FreeOnTerminate := True;
 while not Terminated do
 begin
   if not WaitCommEvent(FComPort.FPort, dwMask, @FOverRead) then
   begin
     if GetLastError = ERROR_IO_PENDING then  WaitForSingleObject(FOverRead.hEvent, INFINITE)
     else
     raise EComPortError.Create('Error waiting port ' + FComPort.PortName+ ' event');
   end;
   if not ClearCommError(FComPort.FPort, dwError, @ComStat) then raise EComPortError.Create('Error clearing port ' + FComPort.PortName);
   FRead :=ComStat.cbInQue;
   if FRead > 0 then
   begin
     if not ReadFile(FComPort.FPort, FBuf, FRead, dwRead, @FOverRead) then raise EComPortError.Create('Error reading port ' + FComPort.PortName);
     Synchronize(DoRead);
   end;
 end;
end;

procedure TReadThread.DoRead;
var  arrBytes: array of Byte;
    i: Integer;
begin
 if Assigned(FComPort.FReadEvent) then
 begin
   SetLength(arrBytes, FRead);
   for i := Low(FBuf) to FRead-1 do   arrBytes[i] := FBuf[i];
   PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
   FComPort.FReadEvent(Self, arrBytes);
 end;
 arrBytes := nil;
end;

constructor TComPort.Create(PortNumber: Cardinal; dcb:Tdcb);
var   tms: TCommTimeouts;
     cmpPrt:TCOMMPROP;
begin
 inherited Create;
 CntByte:=0;
 ZeroMemory(@FOverWrite, SizeOf(FOverWrite));
 FPortName := 'COM' + IntToStr(PortNumber);
 FPort := CreateFile(PChar(FPortName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
 if FPort = INVALID_HANDLE_VALUE then  raise EComPortError.Create('Error opening port ' + PortName);
 try  
   if not GetCommState(FPort, Dcb) then raise EComPortError.Create('Error setting port ' + PortName + ' state');
   tms.ReadIntervalTimeout := 1;
   tms.ReadTotalTimeoutMultiplier := 0;
   tms.ReadTotalTimeoutConstant := 1;
   tms.WriteTotalTimeoutMultiplier := 0;
   tms.WriteTotalTimeoutConstant := 0;
   if not SetCommTimeouts(FPort ,tms)  then raise EComPortError.Create('Error setting port ' + PortName + 'timeouts');
   if not SetCommState(FPort, Dcb) then raise EComPortError.Create('Error setting port ' + PortName + ' state');
   if not SetupComm(FPort,1024,1024)then raise EComPortError.Create('Error setting port ' + PortName + 'Queue Size');
   if not PurgeComm(FPort, PURGE_TXCLEAR or PURGE_RXCLEAR) then raise EComPortError.Create('Error purging port ' + PortName);
   if not SetCommMask(FPort, EV_RXCHAR) then raise EComPortError.Create('Error setting port ' + PortName + ' mask');

   FOverWrite.hEvent := CreateEvent(nil, True, False, nil);
   if FOverWrite.hEvent = Null then raise EComPortError.Create('Error creating write event');

   FReadThread := TReadThread.Create(Self);
 except
   CloseHandle(FOverWrite.hEvent);
   CloseHandle(FPort);
   raise;
 end;
end;

destructor TComPort.Destroy;
begin
 if Assigned(FReadThread) then  FReadThread.Terminate;
 CloseHandle(FOverWrite.hEvent);
 CloseHandle(FPort);
 inherited Destroy;
end;

procedure TComPort.Write(  WriteBytes: array of Byte);
var dwWrite,count: DWORD;
     i:integer;

begin
 if  (not WriteFile(FPort, WriteBytes, 1, dwWrite, @FOverWrite)) and (GetLastError <> ERROR_IO_PENDING) then raise EComPortError.Create('Error writing port ' + PortName);
end;

unit Unit2;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls,SyncObjs,Unit1;

type

 TForm2 = class(TForm)
 {тут компоненты}...
   procedure OnRead(Sender: TObject; ReadBytes: array of Byte);
   procedure FormCreate(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure button1Click(Sender: TObject);
 private
   Port: TComPort;
 public
   { Public declarations }
 end;

var  Form2: TForm2;
     TmpDcb: TDcb;
     docfile:file;
     InTest,OutTest,rend: array  of byte;
     BufIn:array [0..4096] of byte;
     NR,EndF,r:integer;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
var i:integer;
begin
 TmpDcb.BaudRate:=(Combobox2.itemindex+1);
 TmpDcb.Parity := (Combobox3.itemindex);
 TmpDcb.ByteSize := StrToInt(Combobox1.Text);  
 TmpDcb.StopBits :=StrToInt(Combobox4.Text);
 Port := TComPort.Create(upDown1.Position, TmpDcb);
 Port.OnRead := OnRead;
end;

// функция сравнение файлов
procedure Compare(M1, M2: array of byte);
var i,j,min,sum1,sum2:integer;
   PrRas,PrOsh:real;
begin
 PrOsh:=0;
 sum1:=0;sum2:=0;
 PrRas :=100*abs(EndF-(Nr-1))/endf ;  
 For i:=0 to EndF do sum1:=sum1+M1[i];
 For i:=0 to Nr-1 do sum2:=sum2+M1[i];
 PrOsh:=100*abs(sum1-sum2)/sum1;
 ShowMessage('Percent discrepancy:  '+FloatToStr(PrRas)+' %.    '+'Percent mistake '+FloatToStr(PrOsh)+' %.');
end;

procedure TForm2.OnRead(Sender: TObject; ReadBytes: array of Byte);
var  i: Integer;
begin
 for i := Low(ReadBytes) to High(ReadBytes) do
 begin
    if (ProgressBar1.Position+i)<1000 then Memo1.Text := Memo1.Text + chr(ReadBytes[i])+'.';
    OutTest[Nr]:=ReadBytes[i];
    inc(NR) ;
 end;
 ProgressBar1.Position := ProgressBar1.Position +High(ReadBytes);
     memo1.Lines.Add('');

 if   ProgressBar1.Position>= EndF-1 then
 begin
   Memo1.Text := Memo1.Text + '... size = '+intToStr(Nr);
   Compare(Intest,OutTest);
   memo1.Lines.Add('');
   Port.Destroy;
 end;
end;

procedure TForm2.Button2Click(Sender: TObject);
var Mainpath:string;
   i,j:integer;
   Tst:byte;
begin
openDialog1 := TOpenDialog.Create(self);
openDialog1.InitialDir := GetCurrentDir;
if OpenDialog1.Execute then
 begin
  AssignFile(DocFile, OpenDialog1.FileName);
  ReSet(DocFile,1);
  i:=0;r:=0;NR:=0;
  SetLength(InTest,Filesize(DocFile));
  SetLength(OutTest,2*Filesize(DocFile));
  while not Eof(DocFile) do
  begin
   BlockRead(DocFile,Tst, 1);  
   InTest[i]:=ord(Tst);
   BufIn[r]:=InTest[i];
   if r=4095 then
   begin
     Port.Write(BufIn); //отправляем на запись пакетами по 4 кб
     r:=0;
   end;
   if i<1000 then memRead1.Text := memRead1.Text +intToStr(InTest[i])+'.';
   inc(i); inc(r);
  end;
  SetLength(rend,r);
  for  j:= 0 to r-1 do rend[j]:=BufIn[j];
  Port.Write(rend);
  EndF:=i-1;
  memRead1.Text := memRead1.Text + '...  size ='+intToStr(endf+1);
  ProgressBar1.Max :=EndF-1;
  CloseFile(DocFile);
 end;
end;
end.