unitcomm.pas

字模管理程序,为单片机程序汉字显示打印而制.无密码

unit UnitComm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, MSCommLib_TLB, StdCtrls;
const
    cnReturn    =chr(13);
    cnReturnhl    =chr(13)+chr(10);
    SENDLED     =80;
    REVLED      =81;
    KEEPCONN    =82;
    RE_OK       =1;
    CONNECTED   =2;
    NOCARRIER   =3;
    NODIALTONE  =4;
    BUSY        =5;
    CommERR    =6;
    COMPORTERR  =7;
    ATA         =8;
    TIMEOUT     =-1;
    CANCEL      =0;

type
  TComm = class(TForm)
    MSComm: TMSComm;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  protected
    { protected declarations }
  public
    { Public declarations }
    CanCommunicate:boolean;    //TComm标志
    MemoP1:^TMemo;//Pointer;
    meter_addr:array [0..6] of byte; //表地址
    function MetertoGprsSendStr(Sstr:string;command:byte;Passstr:string):boolean;
    function WaitRecive(reciflagbf:array of byte;rflagbflen:integer;rlastbflen:integer;TimeOutms:integer;var recibf:array of byte):boolean;
    function SendStr(Sstr:string):boolean;
    function SendData(const sendbf:array of byte;const bflen:integer;intervalms:integer):boolean;
    function ReciData(var recibf:array of byte;var bflen:integer):boolean;
    procedure Close;
    function Open(ComPort:integer;Setings:string;MemoP:Pointer):boolean;
    procedure ClearCommInfo(TopLine:integer);
    procedure ShowCommInfo(Msg:string);
    procedure SaveCommLog(TopLine:integer);
    function  M645Write(w:word;pass:array of byte;addr:array of byte;databf:array of byte;len:integer):boolean;
    function  M645command(commbyte:byte;addr:array of byte;databf:array of byte;len:integer):boolean;
    function  ReadMeter(CtrCode:word):boolean;
    function  ReadMeter1(CtrCode:word;ty:integer;se:integer):boolean;
    function  SetMeter(Sendbf:array of byte):boolean;
    function  SendCommand(command:byte;Sendbf:array of byte):boolean;
    function  WaitReciveFormatforReadSet(var recibf:array of byte;RS:boolean):integer;
    function  WaitReadMeter2(CtrCode:word;var recibf:array of byte):boolean;
    function  WaitReadMeter1(CtrCode:word;var recibf:array of byte;ty:integer;se:integer):boolean;
  end;
var
  Comm: TComm;
  addsub:byte=$33;
const
    zfx: array [0..1] of string = ('正向','反向');
    ywg: array [0..1] of string = ('有功','无功');
    bss: array [0..2] of string = (' 当前 ',' 上月 ','上上月');
    fltab: array [0..3] of string = ('尖','峰','平','谷');
    xtab: array [0..3] of string = ('总','A','B','C');
    sy: array [0..3] of string = ('失压次数','失压时间','开始时间','结束时间');
implementation

{$R *.dfm}
uses LzpPasLib;
function TComm.Open(ComPort:integer;Setings:string;MemoP:Pointer):Boolean;
var
    dwS,dwE:Dword;
    rcode:integer;
    CommOk:boolean;
begin
    result:=false;
    MemoP1:=MemoP;// @form1.CommInfoMemo;
    try
//        if MSComm.PortOpen then begin
//            MSComm.PortOpen:=false;
//            sleep(300);
//        end;
        if not MSComm.PortOpen then begin
            MSComm.RThreshold:=1;
            MSComm.SThreshold:=1;
            MSComm.InputMode:=ComInputModeBinary;
            MSComm.Settings:=Setings;
            MSComm.Handshaking:=0;
            MSComm.CommPort:=ComPort;
            MSComm.InBufferCount:=0;
            MSComm.InputLen:=0;
            MSComm.PortOpen:=true;
            MSComm.DTREnable:=true;
            MSComm.RTSEnable:=true;
       end;
    except
        on E:Exception do begin
            ShowCommInfo('Com'+inttostr(ComPort)+'串口打不开！');
            exit;
        end;
    end;
   result:=true;
end;
procedure TComm.Close;
begin
    try
      if MSComm.PortOpen then begin
        MSComm.InBufferCount:=0;
        MSComm.OutBufferCount:=0;
        MSComm.RThreshold:=1;
        MSComm.SThreshold:=1;
        MSComm.PortOpen:=false;
      end;
      MSComm.DTREnable:=false;
      MSComm.RTSEnable:=false;
    except
      on E:Exception do
        ShowCommInfo('Comm '+E.Message);
    end;
end;
function TComm.MetertoGprsSendStr(Sstr:string;command:byte;Passstr:string):boolean;
var
    sb:array [0..255] of byte;
    addb:byte;
    Ls,L,i:integer;
begin  //帧头(1 byte)+命令字(1 byte)+[密码]+数据包长度(1 byte)+数据包+校验位(1 byte)+帧尾(1
    sb[0]:=$fe;
    sb[1]:=$40;    //帧头
    sb[2]:=command;
    Ls:=3;
    if command in [0..$7f] then begin
        for i:=1 to 6 do begin
            if Length(Passstr)>=1 then begin
                sb[2+i]:=ord(Passstr[1]);
                delete(Passstr,1,1);
            end else sb[2+i]:=$20;    //' '
        end;
        Ls:=9;
    end;
    L:= Length(Sstr);
    sb[Ls+0]:= lo(L);
    for i:=1 to L do
        sb[Ls+i]:=ord(Sstr[i]);
    addb:=0;
    for i:=1 to Ls+L do
        addb:=addb+sb[i];
    sb[Ls+L+1]:=addb;
    sb[Ls+L+2]:=$24;
    sb[Ls+L+3]:=$fe;
    result:=SendData(sb,Ls+L+4,0);//前后各多发一个字节
end;
function  TComm.SendCommand(command:byte;Sendbf:array of byte):boolean;
var
    sb:array [0..255] of byte;
    addb:byte;
    Ls,L,i:integer;
begin
    sb[0]:=$fe; sb[1]:=$fe;sb[2]:=$fe;sb[3]:=$fe;
    sb[4]:=$68;sb[11]:=$68;
    sb[12]:=command; sb[13]:= Sendbf[0];
    for i:=0 to 5 do sb[i+5]:=meter_addr[i];
    L:= Sendbf[0];
    for i:=0 to L-1 do begin
        sb[14+i]:=Sendbf[1+i]+addsub;
    end;
    addb:=0;
    for i:=4 to 13+L do
        addb:=addb+sb[i];
    sb[13+L+1]:=addb;
    sb[13+L+2]:=$16;
    sb[13+L+3]:=$55;
    result:=SendData(sb,13+L+4,0);//前后各多发
end;
function TComm.M645Write(w:word;pass:array of byte;addr:array of byte;databf:array of byte;len:integer):boolean;
// 645协议写 代码：w, 数据databf,长度:len
var
    i,j,Errcode:integer;
    over,ReadOk:boolean;
    Sendbf:array [0..255] of byte;
    recibf:array [0..255] of byte;
begin
    result:=false;
    Sendbf[0]:=lo(len+2+4);
    Sendbf[1]:=lo(w);
    Sendbf[2]:=hi(w);
//    Sendbf[3]:=1;
//    Sendbf[4]:=$91;
//    Sendbf[5]:=$28;
//    Sendbf[6]:=$73;
    for i:=0 to 5 do begin
        meter_addr[i]:=addr[i];
    end;
    for i:=0 to 3 do begin
        Sendbf[3+i]:=pass[i];
    end;
    for i:=0 to len-1 do begin
        Sendbf[7+i]:=databf[i];
    end;
    for j:=0 to 1 do begin  //两次
        Application.ProcessMessages;
        Comm.SetMeter(Sendbf);
        Errcode:=  Comm.WaitReciveFormatforReadSet(recibf,true);
        if Errcode=0 then begin //正确
            result:=true;
            exit;     //已完成了，如日时段
        end;
    end;
end;
function TComm.M645command(commbyte:byte;addr:array of byte;databf:array of byte;len:integer):boolean;
// 645协议写 代码：w, 数据databf,长度:len
var
    i,j,Errcode:integer;
    over,ReadOk:boolean;
    recibf:array [0..255] of byte;
    sendbf:array [0..255] of byte;
begin
    result:=false;
    for i:=0 to 5 do begin
        meter_addr[i]:=addr[i];
    end;
    Sendbf[0]:=lo(len);
    for i:=0 to len-1 do begin
        Sendbf[1+i]:=databf[i];
    end;
    for j:=0 to 0 do begin  //有些命令不回答，不许发两次，
        Application.ProcessMessages;
        SendCommand(commbyte,Sendbf);
        Errcode:=  WaitReciveFormatforReadSet(recibf,true);
        if Errcode=0 then begin //正确
//            ProgressBar1.Position:=ProgressBar1.Position+1;
            result:=true;
            exit;     //已完成了，如日时段
        end;
    end;
end;

function  TComm.SetMeter(Sendbf:array of byte):boolean;
var
    sb:array [0..255] of byte;
    addb:byte;
    Ls,L,i:integer;
begin
    sb[0]:=$fe; sb[1]:=$fe;sb[2]:=$fe;sb[3]:=$fe;
    sb[4]:=$68;sb[11]:=$68;
    sb[12]:=$04; sb[13]:= Sendbf[0];
    for i:=0 to 5 do sb[i+5]:=meter_addr[i];
    L:= Sendbf[0];
    for i:=0 to L-1 do begin
        sb[14+i]:=Sendbf[1+i]+addsub;
    end;
    addb:=0;
    for i:=4 to 13+L do
        addb:=addb+sb[i];
    sb[13+L+1]:=addb;
    sb[13+L+2]:=$16;
    sb[13+L+3]:=$55;
    result:=SendData(sb,13+L+4,0);//前后各多发
end;
function  TComm.WaitReadMeter1(CtrCode:word;var recibf:array of byte;ty:integer;se:integer):boolean;
var
    num,Errcode:integer;
begin
    result:=false;
    for num:=0 to 1 do begin
        Comm.ReadMeter1(CtrCode,ty,se);  //
        Errcode:=  Comm.WaitReciveFormatforReadSet(recibf,false) ;
        if Errcode=0 then begin
            result:=true;
            exit;
        end;
    end;
end;
function  TComm.WaitReadMeter2(CtrCode:word;var recibf:array of byte):boolean;
var
    num,Errcode:integer;
begin
    result:=false;
    for num:=0 to 1 do begin
        Comm.ReadMeter(CtrCode);  //
        Errcode:=  Comm.WaitReciveFormatforReadSet(recibf,false) ;
        //返回　０：正常应答　　　-1:无应答，　　其它:应答状态字（可能没-33)
        if Errcode=0 then begin
            result:=true;
            exit;
        end else begin
            recibf[0]:=Errcode;
        end;
    end;
end;
function  TComm.ReadMeter(CtrCode:word):boolean;
var
    sb:array [0..255] of byte;
    addb:byte;
    Ls,L,i:integer;
begin
    sb[0]:=$fe; sb[1]:=$fe;sb[2]:=$fe;sb[3]:=$fe;
    sb[4]:=$68; sb[11]:=$68;
    sb[12]:=$01;sb[13]:=$02;
    sb[14]:=lo(CtrCode)+addsub;