unit SendThread;

interface

uses
  Windows, Messages, SysUtils, Classes, Syncobjs, Grids,
   VCLUtils, StdCtrls, ComCtrls, CommInt, HexGrid;

const
    BaudR: array[TBaudRate] of String =
     ('110', '300', '600', '1200', '2400', '4800', '9600', '14400',
      '19200', '38400', '56000', '57600', '115200', '128000', '256000');
    lParity:array[TParity] of string = ('None', 'Odd', 'Even', 'Mark', 'Space');
    lStopbits:array[TStopbits] of string = ('1', '1.5', '2');
    lDatabits:array[TDatabits] of string = ('4', '5', '6', '7', '8');
    lFlowControl:array[TFlowControl] of string = ('None', 'CTS', 'DTR', 'Software', 'Default','AltProg');


type
  TSendStatus = (stOk, stError);
  TEndProcess = procedure of object;
  TExecutedProcess = procedure of object;

  TThreadBuf = array[0..1023] of char;


  ESendThreadError= class(Exception)
  private
    FErrorCode:integer;
  public
    constructor Create(aErrorCode:integer);
    property ErrorCode:integer read FErrorCode;
  end;


  TSendThread = class(TThread)
  private
    Overlapped: TOverlapped;
    CommPort: TComm;
    FEvent: TEvent;
    FEndProcess: TEndProcess;
    FExecutedProcess: TExecutedProcess;
    procedure DoOnEndProcess;
    procedure DoOnExecutedProcess;
  protected
    procedure Execute; override;
    procedure SetTimeouts(ACommTimeOuts:TCommTimeouts);
    function  GetTimeouts: TCommTimeouts;
  public
    constructor Create(CreateSuspended: Boolean;aCommPort: TComm);
    destructor Destroy; override;
    procedure TimeOuts(ReadInterval,ReadMult,ReadConst,WriteMult,WriteConst:DWORD);
    procedure PrepareTimeouts(RdIntT,RdTTM,RdTTC,WrTTM,WrTTC:DWORD);
    procedure Synchronize(Method: TThreadMethod);
    procedure WriteToComm(aCount:DWORD;var Buf: TThreadBuf);
    procedure ReadFromComm(aCount:DWORD;var Buf: TThreadBuf;var aRead:DWORD);
    property OnExecuteProcess: TExecutedProcess read FExecutedProcess write FExecutedProcess;
    property OnEndProcess: TEndProcess read FEndProcess write FEndProcess;
    property CommTimeOuts: TCommTimeouts read GetTimeouts write SetTimeouts;
  end;

implementation

constructor ESendThreadError.Create(aErrorCode:integer);
begin
  FErrorCode:=aErrorCode;
  inherited Create(Format('Error code: %d',[aErrorCode]));
end;


procedure TSendThread.ReadFromComm(aCount:DWORD;var Buf: TThreadBuf;var aRead:DWORD);
begin
    // Чтение данных из порта
    if aCount<>0 then
    begin
      if not Windows.ReadFile(CommPort.Handle,Buf,
                   aCount,aRead,@Overlapped) then
      begin
        if GetLastError <> ERROR_IO_PENDING then
        begin
          // Ошибка выполнения команды
          raise ESendThreadError.Create(GetLastError)
        end
        else
        begin
          // Требуется ожидание выполнения команды
          if WaitForSingleObject(FEvent.Handle, INFINITE)=WAIT_OBJECT_0 then
          begin
            // Произошел тайм-аут
            if not GetOverlappedResult(CommPort.Handle,Overlapped, aRead, FALSE) then
            begin
              // Ошибка после тайм-аута
              raise ESendThreadError.Create(GetLastError)
            end;
          end
          else
          begin
            // Ошибка
            raise ESendThreadError.Create(GetLastError)
          end
        end{if GetLastError <> ERROR_IO_PENDING else}
      end  {if not Windows.ReadFile}
    end;   {if aCount<>0}
   if Self.Terminated then Abort;
end;


procedure TSendThread.WriteToComm(aCount:DWORD;var Buf:TThreadBuf);
var
   FWritten:DWORD;
begin
    // Записать данные в порт
    if aCount<>0 then
    begin
      if not Windows.WriteFile(CommPort.Handle,Buf,
                   aCount,FWritten,@Overlapped) then
      begin
        if GetLastError <> ERROR_IO_PENDING then
        begin
          // Ошибка выполнения команды
          raise ESendThreadError.Create(GetLastError)
        end
        else
        begin
          // Требуется ожидание выполнения команды
          if WaitForSingleObject(FEvent.Handle, INFINITE)=WAIT_OBJECT_0 then
          begin
            // Произошел тайм-аут
            if not GetOverlappedResult(CommPort.Handle,Overlapped, FWritten, FALSE) then
            begin
              // Ошибка после тайм-аута
              raise ESendThreadError.Create(GetLastError);
            end
            else
            begin
              // тайм-аут истек без ошибки
              if FWritten<>aCount then
                // Ошибка не все данные записаны
                raise ESendThreadError.Create(GetLastError);
            end
          end
          else
          begin
            // Ошибка
            raise ESendThreadError.Create(GetLastError);
          end
        end;
      end
      else
      begin
         // Команда выполнена без ошибки и сразу
        if FWritten<>aCount then
          // Ошибка не все данные записаны
          raise ESendThreadError.Create(GetLastError);
      end;
    end;
    if Self.Terminated then Abort;
end;

procedure TSendThread.Synchronize(Method: TThreadMethod);
begin
  inherited Synchronize(Method);
end;

procedure TSendThread.Execute;
begin
  try
   try
    DoOnExecutedProcess;
   finally
    DoOnEndProcess;
   end;
  except
//      PurgeComm(FCommHandle, PURGE_RXABORT +
//                             PURGE_RXCLEAR +
//                             PURGE_TXABORT +
//                             PURGE_TXCLEAR);
//      DoOnEndProcess;

    On E:Exception do
    begin
//     MsgBox('Error',E.Message,MB_OK);
    end
  end {except}
end;

procedure TSendThread.SetTimeouts(ACommTimeOuts:TCommTimeouts);
begin
  Windows.SetCommTimeouts(CommPort.Handle,ACommTimeOuts)
end;

function TSendThread.GetTimeouts:TCommTimeouts;
begin
  Windows.GetCommTimeouts(CommPort.Handle,Result);
end;

procedure TSendThread.PrepareTimeouts(RdIntT,RdTTM,RdTTC,WrTTM,WrTTC:DWORD);
var ATimeOuts:TCommTimeouts;
begin
  ATimeOuts.ReadIntervalTimeout:=RdIntT;
  ATimeOuts.ReadTotalTimeoutMultiplier:=RdTTM;
  ATimeOuts.ReadTotalTimeoutConstant:=RdTTC;
  ATimeOuts.WriteTotalTimeoutMultiplier:=WrTTM;
  ATimeOuts.WriteTotalTimeoutConstant:=WrTTC;
  SetTimeouts(ATimeOuts);
end;

procedure TSendThread.TimeOuts(ReadInterval,ReadMult,ReadConst,WriteMult,WriteConst:DWORD);
var dTime:DWORD;
begin
  dTime:=Trunc(1000*StrToInt(lDataBits[CommPort.DataBits])/StrToInt(BaudR[CommPort.BaudRate]));
  if dTime=0 then dTime:=1;
  PrepareTimeouts(ReadInterval*dTime,
                  ReadMult*dTime,
                  ReadConst*dTime,
                  WriteMult*dTime,
                  WriteConst*dTime);
end;


procedure TSendThread.DoOnEndProcess;
begin
  if Assigned(FEndProcess) then
    Synchronize(FEndProcess);
end;


procedure TSendThread.DoOnExecutedProcess;
begin
  if Assigned(FExecutedProcess) then
    FExecutedProcess;
end;

constructor TSendThread.Create(CreateSuspended: Boolean;aCommPort: TComm);
begin
  FEvent:=TEvent.Create(nil,true,false,'');
  FillChar(Overlapped, Sizeof(Overlapped), 0);
  Overlapped.hEvent := FEvent.Handle;
  CommPort:=aCommPort;
  Self.FreeOnTerminate:=true;
  inherited Create(CreateSuspended);
end;

destructor TSendThread.Destroy;
begin
//  FEvent.SetEvent;
  FEvent.Free;
  inherited Destroy;
end;

end.
