?? 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) ;
//返回 0:正常應答 -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;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -