unit1.~pas

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

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DB, DBClient,DL645lib, StdCtrls, VaComm,
  VaClasses, VaSystem,DateUtils,DLMeter, ExtCtrls, DBCtrls, myconLib,
  ComCtrls;

type
  TForm1 = class(TForm)
    p1: TVaComm;
    Memo2: TMemo;
    cp: TDLMeter;
    tb: TClientDataSet;
    tbID: TStringField;
    tbFun: TStringField;
    tbITEM: TStringField;
    DataSource1: TDataSource;
    Panel1: TPanel;
    DBGrid2: TDBGrid;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    ck: TCheckBox;
    DBNavigator1: TDBNavigator;
    cbf: TComboBox;
    Button4: TButton;
    Label1: TLabel;
    MA: TEdit;
    M1: TEdit;
    M2: TEdit;
    M3: TEdit;
    Button5: TButton;
    Button6: TButton;
    cbBPS: TComboBox;
    Button7: TButton;
    Button3: TButton;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cpWriteLog(sender: TObject; var msg: String);
    procedure cpDebug(sender: TObject; var msg: String);
    procedure cpStop(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure tbNewRecord(DataSet: TDataSet);
    procedure cpPaserBL(sender: TObject; aJH: TJH; aBLSet: TBLSet;
      aBLX: TBLX; aTime: TDateTime; aV: TBL_BKS);
    procedure cpPaserkWh(sender: TObject; aJH: TJH; aYUE: TYUE;
      aBKSet: TBKSet; aFL: TFL; aTime: TDateTime; aV: TkWh_BKS);
    procedure cpPaserPm(sender: TObject; aJH: TJH; aYUE: TYUE;
      aBKSet: TBKSet; aFL: TFL; aTime: TDateTime; aV: TPm_BKS);
    procedure cpPaserPmTime(sender: TObject; aJH: TJH; aYUE: TYUE;
      aBKSet: TBKSet; aFL: TFL; aTime: TDateTime; aV: TPmTime_BKS);
    procedure cbfClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure cpMessage(Sender: TObject; const Data: String);
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  //  procedure CPMessage(Sender: TObject; const Data: String);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  var x1,x2,x3:word;
implementation

{$R *.dfm}

Function Bkwh2str(bkwh:TBlock_kWh):string;
begin
  result:= floattostr(bkwh.kWh_Z) + '   '
         + floattostr(bkwh.kWh_P) + '   '
         + floattostr(bkwh.kWh_A) + '   '
         + floattostr(bkwh.kWh_B) + '   '
         + floattostr(bkwh.kWh_C) + '   '  ;
end;

Function Bpm2str(bpm:TBlock_Pm):string;
begin
  result:= floattostr(bpm.Pm_Z) + ' '
         + floattostr(bpm.Pm_P) + ' '
         + floattostr(bpm.Pm_A) + ' '
         + floattostr(bpm.Pm_B) + ' '
         + floattostr(bpm.Pm_C) + ' '  ;
end;

Function Bpmtime2str(bpm:TBlock_Pmtime):string;
begin
  result:= datetimetostr(bpm.Pmtime_Z) + ' '
         + datetimetostr(bpm.Pmtime_P) + ' '
         + datetimetostr(bpm.Pmtime_A) + ' '
         + datetimetostr(bpm.Pmtime_B) + ' '
         + datetimetostr(bpm.Pmtime_C) + ' '  ;
end;




Function DXCNT2Str(aDXCNT_BK: TBlock_DXCNT ):string;
begin
  result:= '断相次数:'+inttostr(aDXCNT_BK.DXCNT_Z) +' '
                      +inttostr(aDXCNT_BK.DXCNT_A) +' '
                      +inttostr(aDXCNT_BK.DXCNT_B) +' '
                      +inttostr(aDXCNT_BK.DXCNT_C) ;
end;
            

Function DXT2Str(aDXT_BK: TBlock_DXT ):string;
begin
  result:='断相时间: '+inttostr(aDXT_BK.DXT_Z) +' '
                        +inttostr(aDXT_BK.DXT_Z) +' '
                        +inttostr(aDXT_BK.DXT_Z) +' '
                        +inttostr(aDXT_BK.DXT_Z);

end;


Function DXT12ToStr(aDXT1_BK: TBlock_DXT1 ):string;
begin
  result:= '断相起始(结束)时间: '+datetimetostr(aDXT1_BK.DXT_Z) +' '
                         +datetimetostr(aDXT1_BK.DXT_A) +' '
                         +datetimetostr(aDXT1_BK.DXT_B) +' '
                         +datetimetostr(aDXT1_BK.DXT_C)+#13#10

end;

Function XVI2Str(aXVI_BK: TBlock_XV ):string;
begin
  result:=     floattostr(aXVI_BK.X_A ) +'  '
               + floattostr(aXVI_BK.X_B ) +'  '
               + floattostr(aXVI_BK.X_C );


end;


Function XPQCos2Str(aXPQCos_BK: TBlock_XP ):string;
begin
  result:=        floattostr(aXPQCos_BK.X_Z ) +'  '
               +   floattostr(aXPQCos_BK.X_A ) +'  '
               + floattostr(aXPQCos_BK.X_B ) +'  '
               + floattostr(aXPQCos_BK.X_C );


end;






/////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////

procedure TForm1.Button1Click(Sender: TObject);

begin
 cp.ID:= TB['ID'];
 cp.ADR:=edit1.text;
 cp.Go;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
tb.LoadFromFile(tb.FileName);
tb.open;
  p1.Open;   
  cp.DataFinish:=#22;
  x1:=0;x2:=0; x3:=0;

end;



procedure TForm1.cpWriteLog(sender: TObject; var msg: String);
begin
 memo2.lines.add(msg);
end;

procedure TForm1.cpDebug(sender: TObject; var msg: String);
var s:string;   ms:TmemoryStream;
     i:Integer;
begin
  s:=  (cp.STX+msg+#22);
  memo2.lines.add('受到数据.......'+inttostr(Length(s))+'字节 原始数据如下：');
  memo2.lines.add(str2hex(s) );
  { ms:=TmemoryStream.Create;
  ms.WriteBuffer(s[1],length(s) );
  ms.Position:=0;  //  tb['ITEM']+
  ms.SaveToFile( cp.ID + '.dat');
  ms.Free; }
 




end;

procedure TForm1.cpStop(Sender: TObject);
begin
if not ck.Checked then exit;
  memo2.lines.Add('**********');
  if (not tb.Eof)and(cp.going) then begin
    tb.Next;
    Button1Click(nil);
  end;
    
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 cp.stop;
end;






procedure TForm1.tbNewRecord(DataSet: TDataSet);
begin
 tb['ITEM']:='相1';
end;

procedure TForm1.cpPaserBL(sender: TObject; aJH: TJH; aBLSet: TBLSet;
  aBLX: TBLX; aTime: TDateTime; aV: TBL_BKS);
begin
  memo2.Lines.Add('数据标识：'+IDtoStr(cp.ID));
     if ( DX_CNT in aBLSet) then memo2.Lines.add( DXCNT2Str( aV.aDXCNT_BK  ));
     if ( DX_T in aBLSet)   then memo2.Lines.add( DXT2Str ( aV.aDXT_BK ));
     if (  DX_T1 in aBLSet) then memo2.Lines.add( DXT12ToStr(aV.aDXT1_BK  ));
     if (  DX_T2 in aBLSet) then memo2.Lines.add( DXT12ToStr(aV.aDXT2_BK  ));
     if (  X_V in aBLSet)   then memo2.Lines.add( 'V:'+ XVI2Str( aV.aXV_BK  ));
     if (  X_I in aBLSet)   then memo2.Lines.add( 'I:'+  XVI2Str( aV.aXI_BK  )) ;
     if (  X_P in aBLSet)   then memo2.Lines.add( 'P:'+  XPQCos2Str( aV.aXP_BK  ));
     if (  X_Q in aBLSet)   then memo2.Lines.add( 'Q:'+  XPQCos2Str( aV.aXQ_BK  )) ;
     if ( X_COS in aBLSet)  then memo2.Lines.add('Cos:'+  XPQCos2Str ( aV.aXCos_BK  )) ;
end;

procedure TForm1.cpPaserkWh(sender: TObject; aJH: TJH; aYUE: TYUE;
  aBKSet: TBKSet; aFL: TFL; aTime: TDateTime; aV: TkWh_BKS);
begin
     memo2.Lines.Add('数据标识：'+IDtoStr(cp.ID));

     if ( ZP  in aBKSet) then
 memo2.Lines.add(  YUEtostr(aYUE)+ BKtostr(ZP)+ FLtostr(aFL) +':'+ Bkwh2str(aV[ZP ])  );
     if ( FP  in aBKSet)   then
memo2.Lines.add(  YUEtostr(aYUE)+ BKtostr(FP)+ FLtostr(aFL)+':'+Bkwh2str(aV[FP ]) );
     if ( ZQ   in aBKSet) then
memo2.Lines.add(  YUEtostr(aYUE)+ BKtostr(ZQ)+ FLtostr(aFL)+':'+ Bkwh2str(aV[ZQ ]));
     if ( FQ   in aBKSet) then
memo2.Lines.add( YUEtostr(aYUE)+ BKtostr(FQ)+ FLtostr(aFL)+':'+ Bkwh2str(aV[FQ ]));
     if ( ZQL1   in aBKSet)   then
memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(ZQL1)+ FLtostr(aFL)+':'+ Bkwh2str(aV[ZQL1 ]) );
     if ( FQC4   in aBKSet)   then
memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(FQC4)+ FLtostr(aFL)+':'+Bkwh2str(aV[FQC4 ]) ) ;
     if ( ZQC2   in aBKSet)   then
memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(ZQC2)+ FLtostr(aFL)+':'+Bkwh2str(aV[ ZQC2])  );
     if ( FQL3   in aBKSet)   then
memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(FQL3)+ FLtostr(aFL)+':'+ Bkwh2str(aV[FQL3 ]) ) ;

end;


procedure TForm1.cpPaserPm(sender: TObject; aJH: TJH; aYUE: TYUE;
  aBKSet: TBKSet; aFL: TFL; aTime: TDateTime; aV: TPm_BKS);
begin
 memo2.Lines.Add('数据标识：'+IDtoStr(cp.ID));
     if ( ZP  in aBKSet) then
 memo2.Lines.add(  YUEtostr(aYUE)+ BKtostr(ZP)+ FLtostr(aFL)+':'+ BPm2str(aV[ZP ]));
     if ( FP  in aBKSet)   then
 memo2.Lines.add(  YUEtostr(aYUE)+ BKtostr(FP)+ FLtostr(aFL)+':'+ BPm2str(aV[FP ]));
     if ( ZQ   in aBKSet) then
 memo2.Lines.add(  YUEtostr(aYUE)+ BKtostr(ZQ)+ FLtostr(aFL)+':'+ BPm2str(aV[ZQ ]));
     if ( FQ   in aBKSet) then
 memo2.Lines.add( YUEtostr(aYUE)+ BKtostr(FQ)+ FLtostr(aFL)+':'+ BPm2str(aV[FQ ]));
     if ( ZQL1   in aBKSet)   then
 memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(ZQL1)+ FLtostr(aFL)+':'+ BPm2str(aV[ZQL1 ]));
     if ( FQC4   in aBKSet)   then
 memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(FQC4)+ FLtostr(aFL)+':'+ BPm2str(aV[FQC4 ])) ;
     if ( ZQC2   in aBKSet)   then
 memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(ZQC2)+ FLtostr(aFL)+':'+ BPm2str(aV[ ZQC2]) );
     if ( FQL3   in aBKSet)   then
 memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(FQL3)+ FLtostr(aFL)+':'+ BPm2str(aV[FQL3 ]) ) ;

end;

procedure TForm1.cpPaserPmTime(sender: TObject; aJH: TJH; aYUE: TYUE;
  aBKSet: TBKSet; aFL: TFL; aTime: TDateTime; aV: TPmTime_BKS);
begin
  memo2.Lines.Add('数据标识：'+IDtoStr(cp.ID));
     if ( ZP  in aBKSet) then
  memo2.Lines.add(  YUEtostr(aYUE)+ BKtostr(ZP)+ FLtostr(aFL)+':'+ BPmTime2str(aV[ZP ]) );
     if ( FP  in aBKSet)   then
  memo2.Lines.add(  YUEtostr(aYUE)+ BKtostr(FP)+ FLtostr(aFL)+':'+ BPmTime2str(aV[FP ]) );
     if ( ZQ   in aBKSet) then
  memo2.Lines.add(  YUEtostr(aYUE)+ BKtostr(ZQ)+ FLtostr(aFL)+':'+ BPmTime2str(aV[ZQ ]));
     if ( FQ   in aBKSet) then
  memo2.Lines.add( YUEtostr(aYUE)+ BKtostr(FQ)+ FLtostr(aFL)+':'+ BPmTime2str(aV[FQ ]));
     if ( ZQL1   in aBKSet)   then
  memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(ZQL1)+ FLtostr(aFL)+':'+ BPmTime2str(aV[ZQL1 ]));
     if ( FQC4   in aBKSet)   then
  memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(FQC4)+ FLtostr(aFL)+':'+BPmTime2str(aV[FQC4 ]) ) ;
     if ( ZQC2   in aBKSet)   then
  memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(ZQC2)+ FLtostr(aFL)+':'+ BPmTime2str(aV[ ZQC2]) );
     if ( FQL3   in aBKSet)   then
  memo2.Lines.add(   YUEtostr(aYUE)+ BKtostr(FQL3)+ FLtostr(aFL)+':'+ BPmTime2str(aV[FQL3 ]) ) ;

end;

procedure TForm1.cbfClick(Sender: TObject);
begin
  tb.Filter :='ITEM='+QUstr(cbf.Text);
  tb.Filtered:=True;
end;

procedure TForm1.Button4Click(Sender: TObject);
 var bf:Tbuf200;    aC01:TC01_;
     stx:string; cs0:Byte;   len:Integer;
 var PAA,P11,P22,p33:Byte;
begin

   cp.ADR:=edit1.text;
   cp.ID:='C01F';
   aC01.D:=Date; aC01.T:=Time;
   PAA  := strtoInt('$'+MA.Text);
   P11  := strtoInt('$'+M1.Text);
   P22  := strtoInt('$'+M2.Text);
   P33  := strtoInt('$'+M3.Text);
   bf:= GetCmdC01(cp.ADR,aC01, PAA,P11,P22,P33, stx,cs0,Len);
   cp.DataStart:=stx;
   cp.CS0:=CS0;  cp.Active:=true;
   cp.WriteBuf(bf[0],Len);

end;

procedure TForm1.cpMessage(Sender: TObject; const Data: String);
begin
  memo2.Lines.Add(str2hex(data)) ;
  if data[3]<>char($FF) then showmessage('ok')
  else begin
     inc(x3);
     if x3=256 then begin x3:=0;inc(x2); end;
     if x2=256  then begin x2:=0;inc(x1); end;
     if x1=256  then begin x1:=0;  end;
     m3.Text:=  inttohex(x3,2);
     m2.Text:=  inttohex(x2,2);
     m1.Text:=  inttohex(x1,2);

     delay(100);
     Button4Click(nil);
  end;

end;

procedure TForm1.Button6Click(Sender: TObject);
 var bf:Tbuf200;    len:Integer;

begin

   cp.ADR:=edit1.text;
   cp.ID:='C01F';
   bf:= GetCmdBrdTime(now,Len);

    cp.Active:=true;
   cp.WriteBuf(bf[0],Len);

end;


procedure TForm1.Button5Click(Sender: TObject);
 var bf:Tbuf200;    len:Integer;
     bps:Tbps;  stx:string;cs0:Byte;
begin
   bps:=TBps(cbBps.ItemIndex);
   cp.ADR:=edit1.text;
   cp.ID:='C01F';
   bf:= GetCmdUpdateBPS(cp.ADR,bps,stx,cs0,Len);
   cp.STX:=stx; cp.CS0:=cs0;
   
    cp.Active:=true;
   cp.WriteBuf(bf[0],Len);

end;

procedure TForm1.Button7Click(Sender: TObject);
 var bf:Tbuf200;    len:Integer;

begin

   cp.ADR:=edit1.text;
   cp.ID:='C01F';
   bf:= GetCmdBrdFrz(Len);

    cp.Active:=true;
   cp.WriteBuf(bf[0],Len);

end;

procedure TForm1.Button3Click(Sender: TObject);
 var bf:Tbuf200;    len:Integer;
    stx:string; cs0:Byte;
begin
   cp.ADR:=edit2.text;
   edit1.text:=edit2.text;
   cp.ID:='C01F';
   bf:= GetCmdBrdADR(cp.ADR,stx,cs0,len);
   cp.STX:=stx; cp.CS0:=cs0;

    cp.Active:=true;
   cp.WriteBuf(bf[0],Len);

end;

end.