u_rs485.pas

此系统完成了485抄表

unit u_rs485;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils, TComm1, ComCtrls;
function OpenCOM(commport:Tcomportnumber;baudrate:Tbaudrate;parity:Tparity):integer; stdcall; external 'rs485.dll';
function CloseCOM(): integer; stdcall; external 'rs485.dll';
function NgOUT(aa: string;h_ys:integer;revc_ys:integer): integer; stdcall; external 'rs485.dll';
function EasOUT(aa: string;mac_flag:integer;h_ys:integer;revc_ys:integer): integer; stdcall;
external 'rs485.dll';
function XcOUT(aa: string;h_ys:integer;revc_ys:integer): integer; stdcall;
external 'rs485.dll';
type
  TForm1 = class(TForm)
    Comm1: TComm;
    Memo1: TMemo;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Edit4: TEdit;
    Label5: TLabel;
    Edit5: TEdit;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    GroupBox2: TGroupBox;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    GroupBox3: TGroupBox;
    Button4: TButton;
    Button1: TButton;
    Button3: TButton;
    GroupBox4: TGroupBox;
    Button2: TButton;
    Button5: TButton;
    Button6: TButton;
    GroupBox5: TGroupBox;
    RadioButton6: TRadioButton;
    RadioButton7: TRadioButton;
    StatusBar1: TStatusBar;
    Label6: TLabel;
    Edit6: TEdit;
    GroupBox6: TGroupBox;
    RadioButton8: TRadioButton;
    RadioButton9: TRadioButton;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure RadioButton5Click(Sender: TObject);
    procedure RadioButton6Click(Sender: TObject);
    procedure RadioButton7Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  r_data:string;
  r_loop:boolean;
  baud:Tbaudrate;
  com:Tcomportnumber;
  party:Tparity;
implementation

{$R *.dfm}
function tzstrx(bb: string): string;
var lenn, i: integer;
  aa: string;
begin
  lenn := length(bb);
  aa := '';
  i := lenn;
  while i > 0 do
  begin
    aa := aa + copy(bb, i - 1, 2);
    lenn := lenn - 2;
    i := lenn;
  end;
  tzstrx := aa;
end;
function repl(str1: char; long1: integer): string;
var j: integer;
var tt: string;
begin
  j := 1;
  tt := '';
  while j <= long1 do
  begin
    tt := tt + str1;
    j := j + 1;
  end;
  repl := tt;
end;
function d_hex(dec: string): string; //10进制转换16进制
var mod1, bb, sixt, cc, dh1, c2: integer;
var c1, modi1, ccc, dh: string;
begin
  bb := strtoint(dec);
  sixt := 16;
  cc := (bb);
  c1 := '';
  while cc >= sixt do
  begin
    mod1 := cc mod sixt;
    if mod1 >= 10 then
    begin
      case mod1 of
        10: modi1 := 'A';
        11: modi1 := 'B';
        12: modi1 := 'C';
        13: modi1 := 'D';
        14: modi1 := 'E';
        15: modi1 := 'F';
      end;
    end
    else
      modi1 := trim(inttostr(mod1));
    c1 := modi1 + c1;
    cc := cc div sixt;
  end;
  if cc >= 10 then
  begin
    case cc of
      10: ccc := 'A';
      11: ccc := 'B';
      12: ccc := 'C';
      13: ccc := 'D';
      14: ccc := 'E';
      15: ccc := 'F';
    end;
  end
  else
    ccc := inttostr(cc);
  dh := ccc + c1;
  dh1 := length(dh);
  if dh1 <= 4 then
  begin
    c2 := 4 - dh1;
    dh := repl('0', c2) + dh;
  end;
  d_hex := dh;
end;
function h_dec(hex: string): string;
var i, c, l, x, bb, a1, c2, wd, wd1: integer;
var ai, dc: string;
begin
  i := 0;
  c := 0;
  x := 1;
  wd := 1;
  l := length(hex);
  while i < l do
  begin
    case i of
      0: x := 1;
      1: x := 16;
      2: x := 16 * 16;
      3: x := 16 * 16 * 16;
      4: x := 16 * 16 * 16 * 16;
      5: x := 16 * 16 * 16 * 16 * 16;
      6: x := 16 * 16 * 16 * 16 * 16 * 16;
    end;
    bb := l - i;
    ai := copy(hex, bb, 1);
    case ai[1] of
      'A': a1 := 10;
      'a': a1 := 10;
      'B': a1 := 11;
      'b': a1 := 11;
      'C': a1 := 12;
      'c': a1 := 12;
      'D': a1 := 13;
      'd': a1 := 13;
      'E': a1 := 14;
      'e': a1 := 14;
      'F': a1 := 15;
      'f': a1 := 15
    else
      a1 := strtoint(ai);
    end;
    c2 := a1 * x;
    c := c2 + c;
    i := i + 1;
    dc := trim(inttostr(c));
    wd := length(dc);
  end;
  if wd <= 4 then
  begin
    wd1 := 4 - wd;
    dc := repl('0', wd1) + dc;
  end;
  h_dec := dc
end;
function hex_str(str:string):string;
var
  i:integer;
  f_str,v_str:string;
begin
  for i :=1  to (length(str) div 2)  do
  begin
    v_str:=copy(str,2*i-1,2);
    v_str:=h_dec(v_str);
    f_str:=f_str+char(strtoint(v_str));
  end;
  result:=f_str;
end;

function send_jy(str:string):string;
var
  i,jy_data,qd_i:integer;
  f_str,v_str,jy_str:string;
begin
  jy_data:=0;
  qd_i:=0;
  for i :=1  to (length(str) div 2)  do
  begin
    v_str:=copy(str,2*i-1,2);
    if (i<=3) and (strtoint(h_dec(v_str))>=254) then
    begin
      f_str:=f_str+v_str;
      inc(qd_i);
      continue;
    end;
    if i<=10+qd_i then
    begin
      f_str:=f_str+v_str;
      jy_data:=jy_data+strtoint(h_dec(v_str));
    end
    else
    begin
      v_str:=rightstr(inttohex(strtoint(h_dec(v_str))+51,2),2);
      f_str:=f_str+v_str;
      jy_data:=jy_data+strtoint(h_dec(v_str));
    end;
  end;
  jy_str:=rightstr(inttohex(jy_data,2),2);
  f_str:=f_str+jy_str+'16';
  result:=f_str;
end;

function xc_send_jy(str:string):string;
var
  i,jy_data,qd_i:integer;
  f_str,v_str,jy_str:string;
begin
  jy_data:=0;
  qd_i:=0;
  for i :=1  to (length(str) div 2)  do
  begin
    v_str:=copy(str,2*i-1,2);
    if i<=12 then
    begin
      f_str:=f_str+v_str;
    end
    else
    begin
      f_str:=f_str+v_str;
      jy_data:=jy_data+strtoint(h_dec(v_str));
    end;
  end;
  jy_str:=inttohex(jy_data,4);
  f_str:=f_str+copy(jy_str,3,2)+copy(jy_str,1,2);
  result:=f_str;
end;

function revc_jy(str:string):string;
var
  i,jy_data,qd_i:integer;
  f_str,v_str,jy_str:string;
begin
  jy_data:=0;
  for i :=1  to ((length(str) div 2)-2)  do
  begin
    v_str:=copy(str,2*i-1,2);
    jy_data:=jy_data+strtoint(h_dec(v_str));
  end;
  jy_str:=rightstr(inttohex(jy_data,2),2);
  result:=jy_str;
end;
function data_del_33(str:string):string;
var
  i,jy_data,qd_i:integer;
  f_str,v_str,jy_str:string;
begin
  jy_data:=0;
  for i :=1  to (length(str) div 2)  do
  begin
    v_str:=copy(str,2*i-1,2);
    v_str:=rightstr(inttohex(strtoint(h_dec(v_str))-51,2),2);
    f_str:=f_str+v_str;
  end;
  result:=f_str;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  send_str,str,fh_str,ss,kzm,fh_len,err_data,sj_len,js_jy,fh_jy,fh_16,fh_data:string;
  i,data_len:integer;
  p_lean:boolean;
  send_a,aa1,aa2,aa3,aa4,aa5,aacd1,aacd2,bc_pass,ml_len,ss1:string;
begin
   memo1.Clear;
   if radiobutton8.Checked=true then
   begin
     if edit1.Text='' then
     begin
       showmessage('请输入通讯表号');
       edit1.SetFocus;
       exit;
     end;
     if edit2.Text='' then
     begin
       showmessage('请输入通讯命令');
       edit2.SetFocus;
       exit;
     end;
     if radiobutton2.Checked=true then
     begin
       if edit3.Text='' then
       begin
         showmessage('请输入密码');
         edit3.SetFocus;
         exit;
       end;
       if edit6.Text='' then
       begin
         showmessage('请输入编程数据');
         edit6.SetFocus;
         exit;
       end;
     end;
     if radiobutton1.Checked=true then
     begin
       if (radiobutton3.Checked=true) or (radiobutton4.Checked=true) then
       begin