unit1.pas

多功能电表测试程序,用于电表参数读取,例如电量,表号等

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, OleCtrls, MSCommLib_TLB, ComCtrls;

type
  TForm1 = class(TForm)
    MSComm1: TMSComm;
    Panel1: TPanel;
    Label1: TLabel;
    Panel2: TPanel;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    ComboBox1: TComboBox;
    Label3: TLabel;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    GroupBox2: TGroupBox;
    BitBtn3: TBitBtn;
    Edit2: TEdit;
    BitBtn4: TBitBtn;
    GroupBox3: TGroupBox;
    Label4: TLabel;
    Edit3: TEdit;
    Button1: TButton;
    Label5: TLabel;
    Edit4: TEdit;
    ListView1: TListView;
    Panel3: TPanel;
    Label6: TLabel;
    Memo1: TMemo;
    BitBtn5: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
    procedure MSComm1Comm(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
  private
    procedure SendHexData(sData:string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
    Form1: TForm1;
    CurAmmNo:string;
    SendData:string;
    AmmNo:string;
    Code:integer;
    DI1DI0:integer;
    Password:string;
    Data:string;
    senddata1:string;
    SSData:string;

implementation

{$R *.dfm}
procedure Delay(msecs:integer);

var
FirstTickCount:longint;

begin

FirstTickCount:=GetTickCount;
repeat
Application.ProcessMessages;
until ((GetTickCount-FirstTickCount) >= Longint(msecs));

end;


function dec33(sData:string):string;
var
  strTmp,strTmp1:string;
  n,i,l:integer;
begin
  l:=length(sData) div 2;
  for i:=1 to l do
  begin
    strTmp:=Copy(sData,2*i-1,2);
    n:=strtoint('$'+strtmp);
    if n<51 then  n:=n+256;

    n:=n-51;
    strTmp1:=strTmp1+inttohex(n,2);
  end;
  result:=strTmp1;
end;


function add33(sData:string):string;
var
  strTmp:string;
  i,n,nCount:integer;
begin
  nCount:=Length(sData) div 2;
  for i:=1 to nCount do
  begin
    strTmp:=Copy(sData,2*i-1,2);
    n:=strtoint('$'+strTmp);
    n:=n+51;
    if n>=256 then n :=n mod 256;
    Result:=Result+inttohex(n,2);
  end;
end;
function AddingCsCode(Stringvalue: string): string;
var
  i: integer;
  n2: integer;
  str3: string;
begin
  i := 1;
  n2 := 0;
  repeat
    str3 := copy(StringValue, i, 2);
    n2 := n2 + byte(strtoint('$' + str3));
    i := i + 2;
  until i > (length(StringValue));
  n2 := n2 mod 256;
  Result := inttohex(n2, 2);
end;
function ExchangeData(sData:string):string;
var
  i,l:integer;
  strTmp,sTmpBuff:string;
begin
  l:=length(sData) div 2;
  for i:=1 to l do
  begin
    strTmp:=Copy(sData,2*i-1,2);
    sTmpBuff:=strTmp+sTmpBuff;
  end;
  Result:=sTmpBuff;
end;
procedure TForm1.SendHexData(sData:string);
var
  strSendString,strSendData : string;
  strSendBuff : variant;
  setSendBuff1 : array [1..1] of byte;
  i : integer;
begin
  if MSComm1.PortOpen=false then
    MSComm1.PortOpen :=true;
  sData :=trim(sData)+'zz';
  strSendBuff :=vararraycreate([1,1],varbyte);
  strSendString :=sData;
  i:=1;
  strSendData:=copy(strSendString,i,2);
  strSendData := '$'+strSendData;
  repeat
    strSendBuff[1]:=byte(strtoint(strSendData));
    MSComm1.Output :=strSendBuff;
    i:=i+2;
    strSendData:=copy(strSendString,i,2);
    strSendData := '$'+strSendData;
   sleep(10);
  until strSendData='$zz';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
   MSComm1.InputLen :=0;
   MSComm1.InputMode :=1; //以二进制的方式捡回数据
   MSComm1.RThreshold :=1;
   MSComm1.Settings :='1200,e,8,1';

end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  if mscomm1.PortOpen=true then
  BEGIN
    showmessage('端口已经打开');
    exit;
    end
  else
    MsComm1.PortOpen :=true;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  if mscomm1.PortOpen=false then
     showmessage('端口已经关闭')
  else
     MsComm1.PortOpen :=false;
end;

procedure TForm1.ComboBox1Click(Sender: TObject);
var
  cbnum:string;
begin
  edit2.Text:='';
   edit3.Text:='';
    edit4.Text:='';
  cbnum:=combobox1.Items[combobox1.ItemIndex];
  label5.Caption:=combobox1.Items[combobox1.ItemIndex];
  if cbnum='表号' then
    edit1.Text:='C032'
  else if  cbnum='电表常数' then
    edit1.Text:='C030';
end;

procedure TForm1.MSComm1Comm(Sender: TObject);
var
  byteGetdata : array of byte;
  i:integer;
  szReceiveChar:string;
  sData:string;

begin
  //edit3.Clear;
  Case MsComm1.CommEvent of
    comEvReceive:
    begin
      MsComm1.InputLen :=0;
      MsComm1.InputMode :=1;
      try
        byteGetData :=MsComm1.input;
      except
        exit;
      end;
      for i:=low(byteGetData) to high(byteGetData) do
      begin
        try
          SSDATA:=SSDATA+inttohex(byteGetData[i],2);
          sData:=sData+inttohex(byteGetData[i],2);
          edit3.Text:=SSDATA;
        except
        end;
      end;
    end;
  end;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  if edit1.Text='' then
  begin
    showmessage('数据项为空！');
    exit;
  end
  else
  begin
   CurAmmNo:='999999999999';
   senddata1:='68'+CurAmmNo+'68'+'01'+'02'+ExchangeData(add33(edit1.Text));
   senddata:=senddata1+AddingCsCode(senddata1)+'16';
   edit2.text:=senddata;
  end
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var
  first68,second68,last16,CS:string;
  num,num1:string;
  num2,n1,len:integer;
begin
   SendHexData(edit2.Text);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  first68,second68,last16,CS,str:string;
  num,num1:string;
  num2,n1,len:integer;
begin
   if edit3.Text='' then
   showmessage('找不到可以解析的报文！');
if Copy(senddata,1,2)='FE' then
    begin
      if pos('FE68',senddata)>0 then
      begin
        n1:=Pos('68',senddata);
        senddata:=Copy(senddata,n1,1000);
        SendHexData(senddata );
      end
      else
      begin
        exit;
      end;
      end;
    first68:=copy(edit3.Text,1,2);
    second68:=copy(edit3.Text,15,2);
    len:=Strtoint('$'+Copy(edit3.Text,19,2));
    Cs :=Copy(edit3.Text,21+len*2,2);
    str:=Copy(edit3.Text,25,len*2-4);
    last16 :=Copy(edit3.Text,23+len*2,2);
 if (first68=inttostr(68)) and (second68=inttostr(68))and (last16=inttostr(16)) and (cs=AddingCSCode(senddata1))  then
 begin
   if edit2.Text<>'' then
   SendHexData(edit2.Text);
 end;
 edit4.Text:=ExchangeData(dec33(str));
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
var
item:TListItem;
i:string;
first68,second68,last16,CS,str:string;
  num,num1:string;
  num2,n1,len:integer;
  lva:string;
begin
  memo1.Text:='';
  item:=ListView1.Selected;
  if item.SubItems[1]='' then
  begin
    showmessage('数据项为空！');
    exit;
  end
  else
  begin
   CurAmmNo:='999999999999';
   //if listview1.Items[0].SubItems[2]<>'' then
  // begin
   //  senddata1:='68'+listview1.Items[0].SubItems[2]+'68'+'01'+'02'+ExchangeData(add33(item.SubItems[1]));
   //  senddata:=senddata1+AddingCsCode(senddata1)+'16';
  // end
  // else begin
     senddata1:='68'+CurAmmNo+'68'+'01'+'02'+ExchangeData(add33(item.SubItems[1]));
     senddata:=senddata1+AddingCsCode(senddata1)+'16';
     edit2.text:=senddata;
     lva:=senddata;
  //  end
  end;
    SendHexData(lva);
    Delay(500);
    memo1.Text:=edit3.Text;
  if memo1.Text='' then
  begin
    item.SubItems[4]:='通讯失败';
    exit;
    end
  else begin
    len:=Strtoint('$'+Copy(SSDATA,19,2));
    str:=Copy(SSDATA,25,len*2-4);
    item.SubItems[2]:=ExchangeData(dec33(str));
    item.SubItems[4]:='接收到正确的数据';
    ssdata:='';
  end
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
var
  i:integer;
  Rect:TRect;
  nHeigth:integer;
  nMode:integer;
  item:TListItem;
first68,second68,last16,CS,str:string;
  num,num1:string;
  num2,n1,len:integer;
  lva:string;
begin
  i:=0;
//  memo1.Text:='';
 for i:=0 to Listview1.Items.Count -1 do
//if (i<Listview1.Items.Count) then
  begin
   // Listview1.Items[i].Focused  :=true;
    Listview1.Items[i].Selected :=true;
   memo1.Text:='';
    ssdata:='';
  item:=ListView1.Selected;
  if item.SubItems[1]='' then
  begin
    showmessage('数据项为空！');
    exit;
  end
  else
  begin
   CurAmmNo:='999999999999';
     senddata1:='68'+CurAmmNo+'68'+'01'+'02'+ExchangeData(add33(item.SubItems[1]));
     senddata:=senddata1+AddingCsCode(senddata1)+'16';
     edit2.text:=senddata;
     lva:=senddata;
     SendHexData(lva);
  end;

    Delay(400);
    memo1.Text:=SSData;
  if memo1.Text='' then
  begin
  showmessage('发送失败');
    item.SubItems[4]:='通讯失败';
    exit;
    end
  else begin
    len:=Strtoint('$'+Copy(SSDATA,19,2));
    str:=Copy(SSDATA,25,len*2-4);
    item.SubItems[2]:=ExchangeData(dec33(str));
    item.SubItems[4]:='接收到正确的数据';

  end
  end;
    end;
end.