unit ComAscii;

interface

uses
  Windows, SysUtils, Classes, Forms, ComPort;

Type
 {Событие при получении новой строки}
 TNewStrRead = procedure(const NewStr : String) of object;

 {Реализация ASCII-протокола обмена}
 TComAscii = class(TComponent)
   FComPort : TComPort;
  private
    FStartStr: String;
    FEndStr  : String;
    FMaxLen  : Word;
    FOnNewStrRead : TNewStrRead;
    FInBuf   : String;
    FStart   : Boolean;
    procedure SetComPort(const Value: TComPort);
    procedure OnPortReadPacket(const Packet: Pointer;
         const Size: Integer; const ErrCode: Cardinal);
    function  CheckStartStr : Boolean;
    function  CheckEndStr(var S : String) : Boolean;
    procedure CheckMaxLen;
  Public
   Constructor Create(AOwner : TComponent); override;
   Destructor  Destroy; override;
   Procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  Published
   {Привязка к компоненту TComPort}
   Property ComPort : TComPort read FComPort write SetComPort;
   {Стартовая строка}
   Property StartStr: String read FStartStr write FStartStr;
   {Завершающая строка}
   Property EndStr  : String read FEndStr write FEndStr;
   {Максимальная длина принимаемой строки}
   Property MaxLen  : Word read FMaxLen write FMaxLen;
  Published
   {Событие при получении новой строки}
   Property OnNewStrRead : TNewStrRead read FOnNewStrRead write FOnNewStrRead;
  Public
   {Передача строки, согласно протоколу}
   Procedure SendString(const S : String);
   {Передача числа с плавающей точкой}
   Procedure SendSingle(const S : Single; const PointPos : Integer);
 End;

Procedure Register;

implementation

{Добавление ресурса с иконкой для палитры компонент}
{$R *.dcr}

Procedure Register;
Begin
 RegisterComponents('Comm', [TComAscii]);
End;

Constructor TComAscii.Create(AOwner : TComponent);
Begin
 Inherited Create(AOwner);
 FInBuf := '';
 FStart := False;
 FMaxLen:= 10;
End;

Destructor  TComAscii.Destroy;
Begin
 Inherited Destroy;
End;

{Вызывается при операциях в редакторе форм Delphi.}
procedure TComAscii.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  {Если компонент TComPort удалили с формы...}
  if (Operation = opRemove) and (FComPort <> nil) then begin
    if AComponent = FComPort then FComPort:= nil;
  end;
end;

{Передача строки, согласно протоколу}
procedure TComAscii.SendString(const S: String);
begin
 If Assigned(FComPort) then
  If FComPort.Connected then
   FComPort.WriteString(FStartStr + S + FEndStr);
end;

{Передача числа с плавающей точкой}
Procedure TComAscii.SendSingle(const S : Single; const PointPos : Integer);
Begin
 SendString(Format('%.*f', [PointPos, S])); 
End;

{Привязка к компоненту TComPort}
procedure TComAscii.SetComPort(const Value: TComPort);
begin
 FComPort:= nil;
 If Value <> nil then begin
  FComPort:= Value;
  {Заставляем компонент TComPort}
  {пересылать уведомления редактора}
  {форм этому компоненту}
  FComPort.FreeNotification(Self);
  {Перехватываем обработчик получения новых пакетов}
  FComPort.OnReadPacket:= OnPortReadPacket;
 End;
end;

{Обработка получения новой строки}
procedure TComAscii.OnPortReadPacket(const Packet: Pointer;
        const Size: Integer; const ErrCode: Cardinal);
Var S : String; i : Integer;
begin
 {Получаем из буфера строку}
 S:= '';
 For i:= 0 to Size-1 do begin
  S:= S + Char(Pointer(LongInt(Packet)+i)^);
 End;
 {Сохраняем строку во входном буфере}
 FInBuf:= FInBuf + S;

 {Если начало посылки еще не получено...}
 If not FStart then begin
  {Проверяем на наличие символов начала посылки}
  If not CheckStartStr then begin
   CheckMaxLen;
   Exit;
  End;
  {начало посылки найдено и выкинуто...}
  FStart:= True; 
 End;

 {Если начало посылки уже получено...}
 If FStart then begin
  {Проверяем наличие символов конца пакета}
  S:= '';
  If not CheckEndStr(S) then begin
   CheckMaxLen;
   Exit;
  End;
  {конец посылки найден и обработан...}
  If Assigned(FOnNewStrRead) then
   FOnNewStrRead(S);
  FStart:= False; 
 End;
end;

{Проверка на присутствие символов начала посылки }
{Все символы до символов начала посылки удаляются}
{Если начало посылки найдено возвращает True     }
function TComAscii.CheckStartStr : Boolean;
Var i : Integer;
begin
 Result:= False;
 i:= Pos(FStartStr, FInBuf);
 If i = 0 then Exit; {в строке нет начала посылки}
 {удаляем все символы вместе с началом посылки}
 Delete(FInBuf, 1, i + Length(FStartStr)-1);
 Result:= True;
end;

{Ограничение входного буфера}
procedure TComAscii.CheckMaxLen;
var i : Integer;
begin
 i:= Length(FInBuf);
 If i > FMaxLen*2 then
  Delete(FInBuf, 1, i - FMaxLen*2);
end;

{Проверка на присутствие символов конца посылки }
{Если конец посылки найдено возвращает True     }
function TComAscii.CheckEndStr(var S : String) : Boolean;
Var i : Integer;
begin
 Result:= False;
 i:= Pos(FEndStr, FInBuf);
 If i = 0 then Exit; {в строке нет конца посылки}
 {получение "чистой" строки}
 S:= Copy(FInBuf, 1, i-1);
 {удаляем все символы вместе с концом посылки}
 Delete(FInBuf, 1, i + Length(FStartStr));
 Result:= True;
end;

end.
