triggerutil.pas

很好用的串口通信工具软件。Comport目录下是用到的通信控件。

unit TriggerUtil;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes;

type

  TTriggerItem = class(TCollectionItem)
  private
    FTriggerName: string;
    FTriggerHead: string;
    FTriggerLen: Integer;
    FRespondeData: string;
    FRespondeDelay: Integer;
    FActived: Boolean;
    procedure SetTriggerHead(value: string);
    procedure SetRespondeData(value: string);
    procedure SetTriggerLen(value: Integer);
    procedure SetRespondeDelay(value: Integer);
    procedure SetActived(value: Boolean);
    procedure SetTriggerName(value: string);
  public
    procedure Assign(Source: TPersistent); override;
    procedure SaveToStream(stream: TStream);
    procedure LoadFromStream(stream: TStream);

  published
    property TriggerName: string read FTriggerName write SetTriggerName;
    property TriggerHead: string read FTriggerHead write SetTriggerHead;
    property TriggerLen: Integer read FTriggerLen write SetTriggerLen;
    property RespondeData: string read FRespondeData write SetRespondeData;
    property RespondeDelay: Integer read FRespondeDelay write SetRespondeDelay;
    property Actived: Boolean read FActived write SetActived;
  end;

  TTrigger = class(TCollection)
  protected
    function GetItem(Index: Integer): TTriggerItem;
    procedure SetItem(Index: Integer; Value: TTriggerItem);
  public
    property Items[Index: Integer]: TTriggerItem read GetItem write SetItem; default;
    procedure SaveToFile(fn: string);
    procedure LoadFromFile(fn: string);
  end;

function StrToHex(str: string): string;
function HexToStr(str: string): string;
function CheckHex(str: string): boolean;

implementation

procedure TTriggerItem.SetTriggerHead(value: string);
begin
  FTriggerHead := value;
  Changed(False);
end;

procedure TTriggerItem.SetRespondeData(value: string);
begin
  FRespondeData := value;
  Changed(False);
end;

procedure TTriggerItem.SetTriggerLen(value: Integer);
begin
  FTriggerLen := value;
  Changed(False);
end;

procedure TTriggerItem.SetRespondeDelay(value: Integer);
begin
  FRespondeDelay := value;
  Changed(False);
end;

procedure TTriggerItem.SetActived(value: Boolean);
begin
  FActived := value;
  Changed(False);
end;

procedure TTriggerItem.SetTriggerName(value: string);
begin
  FTriggerName := value;
  Changed(False);
end;

procedure TTriggerItem.SaveToStream(stream: TStream);
var sz: Integer;
begin
  sz := length(FTriggerName);
  Stream.Write(sz, Sizeof(sz));
  Stream.Write(FTriggerName[1], sz);
  sz := length(FTriggerHead);
  Stream.Write(sz, Sizeof(sz));
  Stream.Write(FTriggerHead[1], sz);
  Stream.Write(FTriggerLen, Sizeof(FTriggerLen));
  sz := length(FRespondeData);
  Stream.Write(sz, Sizeof(sz));
  Stream.Write(FRespondeData[1], sz);
  Stream.Write(FRespondeDelay, Sizeof(FRespondeDelay));
  Stream.Write(FActived, Sizeof(FActived));
end;

procedure TTriggerItem.LoadFromStream(stream: TStream);
var sz: Integer;
begin
  Stream.Read(sz, Sizeof(sz));
  setLength(FTriggerName, sz);
  Stream.Read(FTriggerName[1], sz);
  Stream.Read(sz, Sizeof(sz));
  setLength(FTriggerHead, sz);
  Stream.Read(FTriggerHead[1], sz);
  Stream.Read(FTriggerLen, Sizeof(FTriggerLen));
  Stream.Read(sz, Sizeof(sz));
  setLength(FRespondeData, sz);
  Stream.Read(FRespondeData[1], sz);
  Stream.Read(FRespondeDelay, Sizeof(FRespondeDelay));
  Stream.Read(FActived, Sizeof(FActived));
end;

procedure TTriggerItem.Assign(Source: TPersistent);
begin
  if Source is TTriggerItem then begin
    if Assigned(Collection) then Collection.BeginUpdate;
    try
      FTriggerName := TTriggerItem(Source).Triggername;
      FTriggerHead := TTriggerItem(Source).TriggerHead;
      FTriggerLen := TTriggerItem(Source).TriggerLen;
      FRespondeData := TTriggerItem(Source).RespondeData;
      FRespondeDelay := TTriggerItem(Source).RespondeDelay;
      FActived := TTriggerItem(Source).Actived;
    finally
      if Assigned(Collection) then Collection.EndUpdate;
    end;
  end
  else inherited Assign(Source);
end;

function TTrigger.GetItem(Index: Integer): TTriggerItem;
begin
  Result := TTriggerItem(inherited GetItem(Index));
end;

procedure TTrigger.SetItem(Index: Integer; Value: TTriggerItem);
begin
  inherited SetItem(Index, Value);
end;

procedure TTrigger.SaveToFile(fn: string);
var i: Integer;
  stream: TFileStream;
begin
  Stream := TFileStream.Create(fn, fmCreate or fmShareDenyWrite);
  i := Count;
  Stream.Write(i, Sizeof(i));
  for i := 0 to Count - 1 do
    Items[i].SaveToStream(Stream);
  Stream.Free;
end;

procedure TTrigger.LoadFromFile(fn: string);
var i, ItemCount: Integer;
  stream: TStream;
  Item: TTriggerItem;
begin
  Stream := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);
  Stream.Read(ItemCount, Sizeof(ItemCount));
  for i := 0 to ItemCount - 1 do
  begin
    Item := Add as TTriggerItem;
    Item.LoadFromStream(Stream);
  end;
  Stream.Free;
end;

function StrToHex(str: string): string;
var i: Integer;
begin
  for i := 1 to Length(str) do
    Result := Result + IntToHex(Ord(str[i]), 2);
end;

function Checkhex(str: string): boolean;
var i: Integer;
begin
  Result := True;
  for i := 1 to Length(str) do
    if not (str[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then
    begin
      Result := false;
      Exit;
    end;
end;

function hexToStr(str: string): string;
var i: Integer;
begin
  if not CheckHex(str) then
    raise Exception.Create('数据内容错误。十六进制数据必须为0..9, A..F');
  for i := 0 to (Length(str) div 2) - 1 do
  begin
    Result := Result + Chr(StrToInt('$' + Copy(str, i * 2 + 1, 2)));
  end;
end;

end.