unit1.pas

此程序完全按照645协议编写的485抄表程序 波特率1200

 xy:=xy+strtoint(s0);
 i:=i+2;
end;
 xorsj:=f_dectohex(xorsj);
 xyw:=f_dectohex(inttostr(xy));
 if length(xyw)>2 then
 xyw:=copy(xyw,2,2);
 if length(xorsj)>2 then
 xorsj:=copy(xorsj,2,2);
 str:=str+xorsj+xyw+'0D';
 aa:=str;
 ss:=hex_str1(str);
 bb:=ss;
 WriteCom(ss);
 sleep(2000);
 j:=ReadCom(val);
 shu:=str_hexpack(val,len);
 Close();
 ccc:=shu;
 ComOutpack:=0
end;
function ComOutpack1(str:string;len:integer):integer;stdcall;
var
s0,s1,s2,s3,ss,shu,clc:string;
xyw,xys,ch,sj,xorsj:string;
xy,i,j,k,xy1,cd,cd1,l:integer;
fp:textfile;
val,val1:pchar;
begin
l:=1;
i:=1;
j:=-1;
ss:='';
xy:=0;
xy1:=0;
xorsj:='0';
while i<length(str) do
begin
 s0:=h_dec(copy(str,i,2));
 xorsj:=inttostr(strtoint(xorsj) xor strtoint(s0));
 xy:=xy+strtoint(s0);
 i:=i+2;
end;
 xorsj:=f_dectohex(xorsj);
 xyw:=f_dectohex(inttostr(xy));
 if length(xyw)>2 then
 xyw:=copy(xyw,2,2);
 if length(xorsj)>2 then
 xorsj:=copy(xorsj,2,2);
 str:=str+xorsj+xyw+'0D';
 aa:=str;
 ss:=hex_str1(str);
 bb:=ss;
 WriteCom(ss);
 sleep(2000);
 for i:=1 to 8 do
 begin
 j:=ReadCom(val);
 case i of
  1:len:=61;
  2:len:=163;
  3:len:=122;
  4:len:=122;
  5:len:=62;
  6:len:=122;
  7:len:=122;
  8:len:=232;
 end;
 shu:=str_hexpackz(val,len);
 ccc:=ccc+shu;
 alldata:=alldata+'()';
 if i<>7 then
 sleep(2000)
 else
 sleep(3000);
 end;
 Close();
 ComOutpack1:=0
end;
function ComOutfh(str:string;len:integer):integer;stdcall;
var
s0,s1,s2,s3,ss,shu,clc,xyz,lsls:string;
xyw,xys,ch,sj:string;
xy,i,j,k,xy1,cd,cd1,l:integer;
fp:textfile;
val,val1:pchar;
begin
l:=1;
i:=1;
j:=-1;
ss:='';
xy:=0;
xy1:=0;
while i<length(str) do
begin
 s0:=h_dec(copy(str,i,2));
 xy:=xy+strtoint(s0);
 i:=i+2;
end;
 xyw:=f_dectohex(inttostr(xy));
 if length(xyw)>2 then
 xyw:=copy(xyw,2,2);
 str:=str+xyw+'0D';
 aa:=str;
 ss:=hex_str1(str);
 bb:=ss;
 WriteCom(ss);
 sleep(1000);
 j:=ReadCom(val);
 shu:='';
 shu:=str_hexpackz(val,len*2+6);
 k:=1;
 xy:=0;
 xyz:='';
 {for i:=1 to len*2+4 do
 begin
    lsls:=copy(shu,k,2);
    xy:=xy+strtoint(h_dec(lsls));
    k:=k+2;
 end;
 xyz:=f_dectohex(inttostr(xy));
 showmessage(xyz+'   '+ copy(trim(shu),length(shu)-3,2));
 if xyz<>copy(trim(shu),length(shu)-3,2) then
 BEGIN
  ComOutfh:=-1;
  EXIT;
 END;}
 ComOutfh:=0
end;
function ComIn(str:string;len:integer):integer;stdcall;
var
s0,s1,s2,s3,ss,shu,clc:string;
xyw,xys,ch,sj:string;
xy,i,j,k,xy1,cd,cd1,l:integer;
fp:textfile;
val:pchar;
begin
s3:=copy(str,1,20);
l:=1;
i:=1;
j:=-1;
ss:='';
xy:=0;
xy1:=0;
while i<21 do
begin
s0:=h_dec(copy(str,i,2));
xy:=xy+strtoint(s0);
i:=i+2;
end;
while i<len do
begin
s0:=h_dec(copy(str,i,2));
//s1:=h_dec('33');
k:=strtoint(s0)+strtoint(s1);
xy:=xy+k;
s2:=f_dectohex(inttostr(k));
ss:=ss+copy(s2,length(s2)-1,2);
i:=i+2;
end;
ss:=s3+ss+copy(f_dectohex(inttostr(xy)),length(f_dectohex(inttostr(xy)))-1,2)+'16';
cd:=length(ss);
ss:=hex_str1(ss);
showmessage(ss);
WriteCom(ss);
sleep(500);
j:=ReadCom(val);
shu:=str_hex(val,len);
showmessage(shu);
if (copy(shu,cd+1,2)='68') and   (copy(shu,cd+15,4)='6884')  then
  result:=0
else
begin
result:=-1;
exit;
end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
combobox1.Text:='COM1';
combobox2.ItemIndex:=0;
edit1.Text:='689999999999996801021F90';
label6.Caption:='';
edit2.Text:='';
edit3.Text:='';


edit5.Text:='';
edit6.Text:='30';
maskedit1.Text:='30';
maskedit2.Text:='0';
memo1.Text:='';
edit1.SetFocus;
end;

procedure TForm1.Button1Click(Sender: TObject);
var rr,s,ttdd,CK,btl1,s0,xyw:string;
    fhbz,sjlong,xy,i:integer;
    fp:textfile;
begin
  label6.Caption:='';
  label6.Refresh ;
  label6.Caption:='正 在 通 讯 . . . . !';
  aa:='';
  bb:='';
  ccc:='';
  memo1.Text:='';
  memo1.Refresh ;
  ck:=trim(combobox1.text);
  btl1:=trim(combobox2.Text);
  if trim(combobox1.Text)='COM1' then
   fhbz:=Open('com1',btl1)
  ELSE
  fhbz:=Open('com2',btl1);
  rr:=trim(edit1.Text);
  fhbz:=comout(rr,strtoint(edit6.text));
  edit2.text:=aa;
  edit3.text:=bb;
  memo1.Text:=alldata;
  IF copy(CCc,1,2)='68' THEN
  BEGIN
   ////////////////////////////
   xy:=0;
   while i<length(alldata) do
   begin
    s0:=h_dec(copy(alldata,i,2));
    xy:=xy+strtoint(s0);
    i:=i+2;
   end;
   xyw:=f_dectohex(inttostr(xy));
   if length(xyw)>2 then
   xyw:=copy(xyw,2,2);
   if xyw=copy(alldata,length(alldata)-3,2) then
   /////////////////////////////
   SHOWMESSAGE('通讯成功')
   else
   showmessage('通讯失败');
   EXIT;
  END
  else
  showmessage('通讯失败');

end;

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

procedure TForm1.Button3Click(Sender: TObject);
var rr,s,sj:string;
    fhbz,sjlong:integer;
    fp:textfile;
begin
  aa:='';
  bb:='';
  ccc:='';
  memo1.Text:='';
  memo1.Refresh ;
  fhbz:=Open('com2','600');
  edit1.Text:='0155012005';
  rr:=trim(edit1.Text);
  fhbz:=comout(rr,5);
  edit2.text:=aa;
  edit3.text:=bb;
  IF CCc='9999' THEN
  BEGIN
  SHOWMESSAGE('通讯失败');
  EXIT;
  end;
  memo1.text:=ccc;
  sjlong:=strtoint(copy(memo1.Text,17,2))*2;
  sj:=copy(memo1.Text,19,sjlong);

end;

procedure TForm1.Button4Click(Sender: TObject);
var rr,s,ttdd:string;
    fhbz,sjlong:integer;
    fp:textfile;
begin
  aa:='';
  bb:='';
  ccc:='';
  memo1.Text:='';
  memo1.Refresh ;
  fhbz:=Open('com2','600');
  rr:=trim(edit1.Text);
  ttdd:='BDBDFE00000000780D';
  fhbz:=comoutfh(ttdd,9);
  fhbz:=comout(rr,strtoint(edit6.text));
  edit2.text:=aa;
  edit3.text:=bb;
  IF CCc='9999' THEN
  BEGIN
   SHOWMESSAGE('通讯失败');
   EXIT;
  END;
  memo1.text:=ccc;
  sjlong:=strtoint(copy(memo1.Text,17,2))*2;
end;

procedure TForm1.Edit1Exit(Sender: TObject);
begin
 edit1.text:=uppercase(edit1.text);
 //edit6.Text:=copy(trimright(edit1.Text),length(trimright(edit1.Text))-1,2);
end;



procedure TForm1.Edit6Exit(Sender: TObject);
begin
edit6.text:=uppercase(edit6.text);
end;

procedure TForm1.Button5Click(Sender: TObject);
var rr,s,ttdd,lsls,bbb,headb,dataa:string;
    fhbz,sjlong,kk,i,aaa:integer;
    fp:textfile;
begin
  alldata:='';
  label6.Caption:='';
  label6.Refresh ;
  label6.Caption:='正 在 通 讯 . . . . !';
  aa:='';
  bb:='';
  ccc:='';
  memo1.Text:='';
  memo1.Refresh ;
  fhbz:=Open('com2','600');
  rr:=trim(edit1.Text);
  fhbz:=comoutpack(rr,strtoint(edit6.text));
  edit2.text:=aa;
  edit3.text:=bb;
  edit5.Text:=alldata;
  memo1.Text :=alldata;
  kk:=1;
  dataa:='';
  headb:=copy(alldata,7, length(alldata)-11);
  for i:=1 to length(headb) div 2 do
  begin
    lsls:=copy(headb,kk,2);
    lsls:=f_dectohex(inttostr(strtoint(h_dec(lsls))-48));
    if length(lsls)<2 then
    lsls:='0'+lsls;
    dataa:=dataa+lsls;
    kk:=kk+2;
  end;
  memo1.text:=alldata;
   IF CCc='9999' THEN
  BEGIN
  SHOWMESSAGE('通讯失败');
  label6.Caption:=' 通 讯 失 败 ....!';
  EXIT;
  END;
  label6.Caption:=' 通 讯 成 功....!';
 // memo1.text:=cc;
  sjlong:=strtoint(copy(memo1.Text,17,2))*2;
end;

procedure TForm1.Button6Click(Sender: TObject);
var rr,heada,data:string;
    fhbz,k:integer;
begin
  packdata:='';
  label6.Caption:='';
  label6.Refresh ;
  label6.Caption:='正 在 通 讯 . . . . !';
  aa:='';
  bb:='';
  ccc:='';
  memo1.Text:='';
  memo1.Refresh ;
  fhbz:=Open('com2','600');
  rr:=trim(edit1.Text);
  fhbz:=comoutpack1(rr,strtoint(edit6.text));
  edit2.text:=aa;
  edit3.text:=bb;
  edit5.Text:=alldata;
  memo1.Text :=alldata;
  k:=1;
  data:='';
  heada:=copy(alldata,7, length(alldata)-11);
  {for i:=1 to length(heada) div 2 do
  begin
    lsls:=copy(heada,k,2);
    lsls:=f_dectohex(inttostr(strtoint(h_dec(lsls))-48));
    if length(lsls)<2 then
    lsls:='0'+lsls;
    data:=data+lsls;
    k:=k+2;
  end;
  memo1.text:=data;  }
  {xy:=0;
  xyz:='';
  for i:=1 to length(alldata) div 2 -2 do
  begin
    lsls:=copy(alldata,k,2);
    xy:=xy+strtoint(h_dec(lsls));
    k:=k+2;
  end;
  xyz:=f_dectohex(inttostr(xy));
  memo2.Text:=cc;
  showmessage(xyz+'   '+ copy(alldata,length(alldata)-3,2));
  if xyz<>copy(alldata,length(alldata)-3,2) then
  BEGIN
  SHOWMESSAGE('通讯失败');
  label6.Caption:=' 通 讯 失 败 ....!';
  EXIT;
  END;   }
end;

procedure TForm1.Button7Click(Sender: TObject);
var str,lsls,s0,xyw,ss,shu,rr,sj,head:string;
    fhbz,i,j,xy,len,t,count,long:integer;
    fp:textfile;
    val:pchar;
    stra:string;
begin
 label6.Caption:='';
 label6.Refresh ;
 label6.Caption:='正 在 通 讯 . . . . !';
 memo1.Text:='';
 memo1.Refresh ;
 if trim(combobox1.Text)='COM1' then
  fhbz:=Open('com1','600')
 ELSE
  fhbz:=Open('com2','600');
 rr:=trim(edit1.Text);
 while i<length(str) do
 begin
  s0:=h_dec(copy(str,i,2));
  xy:=xy+strtoint(s0);
  i:=i+2;
 end;
 xyw:=f_dectohex(inttostr(xy));
 if length(xyw)>2 then
 xyw:=copy(xyw,2,2);
 stra:=stra+xyw+'0D';
 ss:=hex_str1(stra);
 WriteCom(ss);
 sleep(1000);
 j:=ReadCom(val);
 shu:='';
 count:=0;
 str:='';
 head:=copy(trim(edit1.Text),1,2);
 long:=strtoint(trim(edit6.Text));
 i:=1 ;
 xy:=0;
 while i<7 do
 begin
   lsls:=inttostr(ord(val[count]));
   sj:=f_dectohex(lsls);
   xy:=xy+strtoint(h_dec(sj));
   str:=str+sj;
 end;
 count:=i;
 if (copy(str,1,2)=head) and (copy(str,3,2)='4F') AND (copy(str,5,2)='4B') AND (copy(str,7,2)=head) and ((copy(str,9,2)='AA') OR (copy(str,9,2)='A5')) THEN
 begin
  while count<=long do
  begin
   lsls:=inttostr(ord(val[count]));
   sj:=f_dectohex(lsls);
   if length(sj)<2 then
   sj:='0'+sj;
   str:=str+sj;
   xy:=xy+strtoint(h_dec(sj));
   alldata:=alldata+sj;
   count:=count+1;
  end;
  if long<10 then
  len:=long
  else
  len:=long*2;
  xyw:=f_dectohex(inttostr(xy));
  if (sj='0D') and (count=10+len) and (copy(str,length(str)-4,2)=xyw) then
  begin
   memo1.Text :=alldata;
   edit5.Text:=str;
  end
  else
  BEGIN
  edit5.Text:=str;
  SHOWMESSAGE('通讯失败');
  label6.Caption:=' 通 讯 失 败 ....!';
  EXIT;
END;
end
else
BEGIN
  SHOWMESSAGE('通讯失败');
  label6.Caption:=' 通 讯 失 败 ....!';
  EXIT;
END;

end;

procedure TForm1.Button8Click(Sender: TObject);
var rr,s,ttdd,lsls,bbb,headb,dataa:string;
    fhbz,sjlong,kk,i,aaa:integer;
    fp:textfile;
begin
  memo1.Text:='';
  memo1.Refresh ;
  kk:=1;
  dataa:=trim(edit1.Text);
  headb:=copy(dataa,1, length(dataa));
  dataa:='';
  for i:=1 to length(headb) div 2 do
  begin
    lsls:=copy(headb,kk,2);
    lsls:=f_dectohex(inttostr(strtoint(h_dec(lsls))-48));
    if length(lsls)<2 then
    lsls:='0'+lsls;
    dataa:=dataa+lsls;
    kk:=kk+2;
  end;
end;

procedure TForm1.Button9Click(Sender: TObject);
var str,lsls,s0,xyw,ss,shu,rr,sj,head:string;
    fhbz,i,j,xy,len,t,count,long:integer;
    fp:textfile;
    val:pchar;
    stra:string;
begin