vasystem.~pas

符合DL645规约的电能表数据解析. 可直接实现远程RTU.

{***************************************************************************}
{ TMS Async32                                                               }
{ for Delphi 4.0,5.0,6.0 & C++Builder 4.0,5.0,6.0                           }
{                                                                           }
{ Copyright 1996 - 2002 by TMS Software                                     }
{ Email : [e-mail]                                              }
{ Web : http://www.tmssoftware.com                                          }
{                                                                           }
{ The source code is given as is. The author is not responsible             }
{ for any possible damage done due to the use of this code.                 }
{ The component can be freely used in any application. The complete         }
{ source code remains property of the author and may not be distributed,    }
{ published, given or sold in any form as such. No parts of the source      }
{ code can be included in any other component or application without        }
{ written authorization of the author.                                      }
{***************************************************************************}

unit VaSystem;

{$I VALIB.INC}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  VaTypes, VaClasses, VaComm, VaTriggers;


type
  TVaWaitMessageEvent = procedure(Sender: TObject; Index: Integer) of object;
  TVaWaitMessage = class(TVaCommComponent)
  private
    FStrings: TStrings;
    FCompareData: TStrings;
    FReceived: TStrings;
    FCaseSensitive: Boolean;
    FOnMessage: TVaWaitMessageEvent;
    procedure SetStrings(Value: TStrings);
    procedure StringsChanged(Sender: TObject);
  protected
    procedure ReceiveChar(Ch: Char);
    procedure DataChanged(Data: PVaData; Count: Integer); override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ResetStrings;
  published
    property Strings: TStrings read FStrings write SetStrings;
    property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive default false;
    property OnMessage: TVaWaitMessageEvent read FOnMessage write FOnMessage;
    property Active;
  end;

  TVaCaptureMsgEvent = procedure(Sender: TObject; const Data: string) of object;
  TVaCapture = class(TVaCommComponent)
  private
    FExpTimer:TVaTimer;
    FExpTime:Integer;
    FDataStart: string;
    FDataFinish: string;
    FMaxMsgLen: Integer;
    FOnMessage: TVaCaptureMsgEvent;
    FDataLen: Integer;
    FonExpTime: TNotifyEvent;
    procedure SetDataStart(const Value: string);
    procedure SetDataFinish(const Value: string);
    procedure HandleMessage(Msg: string);
    procedure TimeoutEvent(Sender: TObject);
    procedure SetExpTime(const Value: integer);
  protected
    Buffer: string;
    StartCtrl: string;
    FinishCtrl: string;
    StartLen, FinishLen: Integer;
    Prefix: string;
    Level: Integer;
    procedure ReceiveChar(Ch: Char);
    procedure DataChanged(Data: PVaData; Count: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Reset;
    procedure StartExp;
    procedure WriteText(s:string);
    Function WriteBuf(var buf;Count:Integer):Integer;

  published
    property DataStart: string read FDataStart write SetDataStart;
    property DataFinish: string read FDataFinish write SetDataFinish;
    property DataLen: Integer read FDataLen write FDataLen;
    
    property ExpTime :integer read FExpTime write SetExpTime;
    property OnExpTime :TNotifyEvent read FOnExpTime write FOnExpTime;


    property MaxMsgLen: Integer read FMaxMsgLen write FMaxMsgLen default 999;


    property OnMessage: TVaCaptureMsgEvent read FOnMessage write FOnMessage;
    
    property Active;
  end;


implementation

uses
  VaUtils;


{ TVaWaitMessage }

constructor TVaWaitMessage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCaseSensitive := false;
  FReceived := TStringList.Create;
  FCompareData := TStringList.Create;
  FStrings := TStringList.Create;
  TStringList(FStrings).OnChange := StringsChanged;
end;

destructor TVaWaitMessage.Destroy;
begin
  FStrings.Free;
  FCompareData.Free;
  FReceived.Free;
  inherited Destroy;
end;

procedure TVaWaitMessage.Loaded;
begin
  inherited Loaded;
  ResetStrings;
end;

procedure TVaWaitMessage.ResetStrings;
var
  I: Integer;
begin
  FReceived.Assign(Strings);
  for I := 0 to FReceived.Count - 1 do
    FReceived[I] := '';
  FCompareData.Assign(Strings);
  for I := 0 to FCompareData.Count - 1 do
    FCompareData[I] := StrCtrl(FCompareData[I]);
end;

procedure TVaWaitMessage.SetStrings(Value: TStrings);
begin
  FStrings.Assign(Value);
end;

procedure TVaWaitMessage.StringsChanged(Sender: TObject);
begin
  ResetStrings;
end;

procedure TVaWaitMessage.ReceiveChar(Ch: Char);
var
  Org, Temp: string;
  I, R: Integer;
begin
  for I := 0 to FReceived.Count - 1 do
  begin
    Org := FCompareData[I];
    Temp := FReceived[I] + Ch;
    if CaseSensitive then
      R := CompareStr(Temp, Org)
    else R := CompareText(Temp, Org);

    if (R = 0) and (Assigned(FOnMessage)) then
      FOnMessage(Self, I);

    if Length(Temp) = Length(Org) then
      Delete(Temp, 1, 1);
    FReceived[I] := Temp;
  end;
end;

procedure TVaWaitMessage.DataChanged(Data: PVaData; Count: Integer);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    ReceiveChar(CN(Data^[I]));
end;

{ TVaCapture }

constructor TVaCapture.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FExpTimer:=TVaTimer.Create(self);
  FExpTimer.Enabled := false;
  FExpTimer.Interval := 5000; //5 seconds
  FExpTime:= 5000; //5 seconds
  FExpTimer.OnTimer :=TimeoutEvent;
  FMaxMsgLen := 999;
end;

destructor TVaCapture.Destroy;
begin
  FExpTimer.Free;
  inherited Destroy;
end;

procedure TVaCapture.TimeoutEvent(Sender: TObject);
begin
  FExpTimer.Enabled := false;
  if Assigned(FOnExpTime) then   FOnExpTime(Self);
end;


procedure TVaCapture.SetDataStart(const Value: string);
begin
  if FDataStart <> Value then
  begin
    FDataStart := Value;
    StartCtrl := strCtrl(FDataStart);
    StartLen := Length(StartCtrl);
  end;
end;

procedure TVaCapture.SetDataFinish(const Value: string);
begin
  if FDataFinish <> Value then
  begin
    FDataFinish := Value;
    FinishCtrl := StrCtrl(FDataFinish);
    FinishLen := Length(FinishCtrl);
  end;
end;

procedure TVaCapture.Reset;
begin
  Level := 0;
  Prefix := '';
  Buffer := '';
  FExpTimer.Enabled := false;
end;

procedure TVaCapture.HandleMessage(Msg: string);
begin
  FExpTimer.Enabled := false;
  try
    if Assigned(FOnMessage) then FOnMessage(Self, Msg);
  except
    Application.HandleException(Self);
  end;
end;

procedure TVaCapture.ReceiveChar(Ch: Char);
begin
  case Level of
    0:
      begin
        Prefix := Prefix + Ch;
        if (Prefix = StartCtrl) or (StartCtrl = '') then
        begin
          Level := 1;
          Prefix := '';
          if StartCtrl = '' then
            Buffer := Ch;
          Exit;
        end;
        if Length(Prefix) = StartLen then
          Delete(Prefix, 1, 1);
      end;
    1:
      begin
        Prefix := Prefix + Ch;
       if (Prefix = FinishCtrl)  then
        begin
          Level := 0;
          Prefix := '';
          HandleMessage(Buffer);
          Buffer := '';
          Exit;
        end; 

        if Length(Prefix) = FinishLen then
          Delete(Prefix, 1, 1);
        Buffer := Buffer + Ch;


        if (Length(Buffer) >= FDataLen) then
        begin
          Level := 0;
          Prefix := '';
          HandleMessage(Buffer);
          Buffer := '';
          Exit;
        end;



        while Length(Buffer) > FMaxMsgLen do
          Delete(Buffer, 1, 1);


      end;
  end; //case
end;

procedure TVaCapture.DataChanged(Data: PVaData; Count: Integer);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    ReceiveChar(CN(Data^[I]));
end;




procedure TVaCapture.StartExp;
begin
  FExpTimer.Enabled := True;
end;

procedure TVaCapture.SetExpTime(const Value: integer);
begin
  FExpTimer.Enabled := false;
  FExpTime := Value;
  FExpTimer.Interval:=Value;

end;

procedure TVaCapture.WriteText(s: string);
begin
  Comm.WriteText(s) ;
  FExpTimer.Enabled := true;
end;

function TVaCapture.WriteBuf(var buf; Count: Integer): Integer;
begin
  result:= Comm.WriteBuf(buf,Count) ;
  FExpTimer.Enabled := true;
end;

end.