📄 global.pas
字号:
unit Global;
interface
uses Sysutils, forms, intercom,dm,promot,pasMain, db,info, Err;
function PutTXD(Sbuf: String; RXDlen: Integer; var Rbuf: String;timeInterval:integer): Boolean;
function GetRXD(RXDlen: Integer; var Rbuf: String): Boolean;
function CurTime: string;
function Dialup(TelNo: String): Integer;
procedure Hangup(Sender: TObject);
function SetupCommunication(Sender: Tobject): Boolean;
procedure AutoReadMeter(Sender: TObject);
procedure AutoReadMeterCRM(Sender: TObject);
function ReadConcentrator: Boolean;
procedure DumpData(DNumber: String; ReadTime: String; RecordLen: Integer);
function ConvertID(ID: String): String;
var
DNOstr, dNameStr, dTelStr: String;
UNOstr, NameStr, AddressStr: String;
DialOK:string;
ActiveCommand: Boolean;
BreakRead: Boolean;
MonitorFlag:Boolean;
SearchFlag:Boolean;
Unlockflag:Boolean;
RunFlag: Integer;
ChartFlag: Integer;
AnalyseFlag: Integer;
DialExit, DialRS232: Integer;
DataLen, DataLen1: Integer;
ReadTime: String;
Auto, AutoCRM: Integer;
Timing: Integer;
dbname:string;
printitem:integer;
rtConnect: Integer;
TextData1: array[0..1000, 0..14] of String;
TextData2: array[0..1000, 0..14] of String;
const USEREDIT:Integer = 1;
const ANALYZING:Integer = 2;
const SEARCHRDT:Integer = 4;
const MONITORING:Integer = 3;
const COMMANDTN0:Integer = 5;
const CUSTOMCONSUMPTION = 6;
const _TOTALPOWER = 0;
const _CONSUMERPOWER = 1;
const _WASTAGE = 2;
const _CR: Char = Chr(13);
const _Lock: string = 'Lock';
const _Unlock: string = 'Unlock';
const _OK: String = 'OK' + Chr(13) + Chr(10);
const _CRLF: String = Chr(13) + Chr(10);
const _YES: String = '0000';
const _OKlen: Integer = 4;
const _OFF: String = 'OFF' + Chr(13);
//Define Control Command
const _ClrTseg:String = 'BAN' + Chr(13);
const _SetTseg:String = 'J';
const _GetTseg:String = 'I' + Chr(13);
const _TsegLen:Integer = 10;
const _MaxTsegNum:Integer = 24;
const _ClrID:String = 'DEL' + Chr(13);
const _SetID:String = 'A';
const _GetID:String = 'N' + Chr(13);
const _MaxIDNum:Integer = 1000;
const _GetAllRec:String = 'TN0' + Chr(13);
const _RecLen:Integer = 133;
implementation
function PutTXD(Sbuf: String; RXDlen: Integer; var Rbuf: String; timeInterval:Integer): Boolean;
begin
UnLockFlag:=false;
with frmMain do
begin
//TXD control
MSComm.RThreshold := 0;
MSComm.InputLen := RXDlen;
MSComm.InBufferCount := 0;
//Send string
MSComm.Output := Sbuf;
//Timer control
TimerOut.Enabled := FALSE;
TimeOutF := FALSE;
TimerOut.Interval := timeInterval;
TimerOut.Enabled := TRUE;
//Recieving control
while TRUE do
begin
if MSComm.InBufferCount >= RXDlen then break;
if not ActiveCommand then break;
Application.ProcessMessages;
if not ActiveCommand then break;
if TimeOutF then
begin
TimeOutF := FALSE;
TimerOut.Enabled := FALSE;
Rbuf := MSComm.Input;
if copy(rbuf,1,4)=_Lock then
UnLockFlag:=false
else
UnLockFlag:=true;
Result := FALSE;
Exit;
end;
end;
//Read RXT data
Rbuf := MSComm.Input;
if copy(Rbuf,1,4)=_Lock then
UnLockFlag:=false
ELSE
UnLockFlag:=True;
//Reset parameter
TimeOutF := FALSE;
TimerOut.Enabled := FALSE;
Result := TRUE;
end;
end;
function GetRXD(RXDlen: Integer; var Rbuf: String): Boolean;
begin
with frmMain do
begin
//Setup recieved length
MSComm.RThreshold := 0;
MSComm.InputLen := RXDlen;
//Timer control
TimerOut.Enabled := FALSE;
TimeOutF := FALSE;
TimerOut.Interval := 4000;
TimerOut.Enabled := TRUE;
//Recieving control
while TRUE do
begin
if MSComm.InBufferCount >= RXDlen then break;
if not ActiveCommand then break;
Application.ProcessMessages;
if not ActiveCommand then break;
if TimeOutF then
begin
//Reset parameter
TimeOutF := FALSE;
TimerOut.Enabled := FALSE;
Result := FALSE;
Exit;
end;
end;
//Read RXT data
Rbuf := MSComm.Input;
//Reset parameter
TimeOutF := FALSE;
TimerOut.Enabled := FALSE;
Result := TRUE;
end;
end;
function CurTime: string;
var
StrTmp: string;
Present: TDateTime;
Year, Month, Day, Hour, Min, Sec, MSec: Word;
begin
Present:= Now;
DecodeDate(Present, Year, Month, Day);
StrTmp := IntToStr(Year) + '-';
if Length(IntToStr(Month)) = 1 then
StrTmp := StrTmp + '0';
StrTmp := StrTmp + IntToStr(Month) + '-';
if Length(IntToStr(Day)) = 1 then
StrTmp := StrTmp + '0';
StrTmp := StrTmp + IntToStr(Day) + ' ';
DecodeTime(Present, Hour, Min, Sec, MSec);
if Length(IntToStr(Hour)) = 1 then
StrTmp := StrTmp + '0';
StrTmp := StrTmp + IntToStr(Hour) + ':';
if Length(IntToStr(Min)) = 1 then
StrTmp := StrTmp + '0';
StrTmp := StrTmp + IntToStr(Min) + ':';
if Length(IntToStr(Sec)) = 1 then
StrTmp := StrTmp + '0';
Result := StrTmp + IntToStr(Sec);
end;
function Dialup(TelNo: String): Integer;
var
Buf, TmpBuf : String;
i: Integer;
begin
if DialRS232 = 1 then
begin
Dialup := 1;
frmMain.dial_t.Enabled:=true;
Exit;
end;
//Check ststus from MODEM
if frmMain.MSComm.CDHolding Then
begin
TmpBuf := Curtime;
DialOK:=dtelstr;
Command.ListBox.Items.Add(TmpBuf + ' ' + '数据链路已经建立.');
Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;
Command.listbox.SetFocus;
dialup:=1;
frmMain.dial_t.Enabled:=true;
exit;
end;
ActiveCommand := True;
for i := 1 to 10 do
begin
//1) Dial telephone
if frmMain.MSComm.CDHolding then break;
frmMain.MSComm.InBufferCount:= 0; //Clear input buffer
frmMain.MSComm.InputLen := 1;
TimeoutF:= False;
frmMain.TimerOut.Enabled := False;
frmMain.TimerOut.Interval:= 60000;
//frmMain.MSComm.Output:= 'ATH1' + Chr(13); //Hangup modem
//frmmain.Delay1S(frmMain);
frmMain.MSComm.Output:= 'ATDT' + TelNo + Chr(13); //Dial telephone number
TmpBuf:= Curtime;
Command.ListBox.Items.Add( TmpBuf + ' ' + 'ATDT' + telno);
Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;
frmMain.TimerOut.Enabled := True ;
Command.ListBox.Items.Add('正在拨号,请等待...');
Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;
Command.listbox.SetFocus;
//2) Detect Carrier Signal
TmpBuf :='';
while True do
begin
if not ActiveCommand then break;
Application.ProcessMessages;
if not ActiveCommand then break;
If TimeoutF = True then break ;
if frmMain.MSComm.InBufferCount >= 1 then
begin
Buf := frmMain.MSComm.Input;
TmpBuf := TmpBuf + Buf;
if Buf = Chr(10) then
begin
Command.ListBox.Items.Add(Copy(TmpBuf, 1, Length(TmpBuf) - 2));
Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;
TmpBuf := '';
end;
end;
if frmMain.MSComm.CDHolding then
begin
Command.ListBox.Items.Add(Curtime +' 数据链路建立.');
Command.ListBox.ItemIndex := command.ListBox.Items.Count - 1;
frmMain.dial_t.Enabled:=true;
break;
end;
frmMain.dial_t.Enabled:=true;
end;
if not activecommand then exit;
end;
frmMain.Timerout.Enabled := False;
if TimeoutF = False then
begin
frmMain.MSComm.Output := Chr(13);
frmMain.MSComm.Output := Chr(13);
frmMain.MSComm.Output := Chr(13);
frmMain.Delay1s(frmmain);
frmmain.MSComm.InBufferCount:=0;
DialOK:=dtelstr;
TimeoutF:= False;
dialup:=1;
frmMain.Timerout.Interval := 10000;
frmMain.dial_t.Enabled:=true;
Exit;
end
else
begin
Command.ListBox.Items.Add('拨号不成功,请检查电话线路.');
Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;
dialup := 0;
TimeoutF := false;
frmmain.MSComm.inbuffercount:=0;
frmMain.TimerOut.Interval := 10000;
frmMain.dial_t.Enabled:=true;
end;
end;
procedure AutoReadMeter(Sender: TObject);
var
TimeStr: string;
i, rtConnect: Integer;
begin
if Auto <> 2 then exit;
DM1.TestArgDB.First;
If DM1.TestArgDB.Eof Then
begin
frmMain.RunTestTimer.Enabled := False;
Auto := 0;
frmMain.RunTimg.Enabled := TRUE;
frmMain.StopTiming.Enabled := FALSE;
WarnAbout.Hide;
WarnAbout.Promot.Caption := '无定时抄表参数!';
WarnAbout.ShowModal ;
exit;
end;
DM1.DSTdb.Filter := 'DNO = ' + '''' + DM1.TestArgDB.FieldByName('DNO').AsString + '''';
if DM1.DSTdb.Eof then
begin
frmMain.RunTestTimer.Enabled := False;
Auto := 0;
frmMain.RunTimg.Enabled := TRUE;
frmMain.StopTiming.Enabled := FALSE;
WarnAbout.Hide;
WarnAbout.Promot.Caption := '参数错误,请修改!';
WarnAbout.ShowModal;
exit;
end;
rtConnect := 0;
DM1.TestArgDB.First;
while not DM1.TestArgDB.Eof do
begin
//Compute time, not considering year and seconds, such as, 05-20 16:43
//Case 1 ####-05-20 16:46:00
if (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 6, 2) <> '##') and (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 9, 2) <> '##') and (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 12, 2) <> '##') then
begin
TimeStr := Copy(CurTime, 6, 11);
if (TimeStr = Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 6, 11)) and (Copy(CurTime, 18, 2) < '20') then
begin
frmMain.RunTestTimer.Enabled := False;
rtConnect := Dialup(DM1.DSTdb.FieldByName('Tel').AsString);
If rtConnect = 1 then break;
end;
end;
//Case 2 ####-##-20 16:46:00
if (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 6, 2) = '##') and (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 9, 2) <> '##') and (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 12, 2) <> '##') then
begin
TimeStr := Copy(CurTime, 9, 8);
if (TimeStr = Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 9, 8)) and (Copy(CurTime, 18, 2) < '20') then
begin
frmMain.RunTestTimer.Enabled := False;
rtConnect := Dialup(DM1.DSTdb.FieldByName('Tel').AsString);
If rtConnect = 1 then break;
end;
end;
//Case 3 ####-##-## 16:46:00
if (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 6, 2) = '##') and (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 9, 2) = '##') and (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 12, 2) <> '##') then
begin
TimeStr := Copy(CurTime, 12, 5);
if (TimeStr = Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 12, 5)) and (Copy(CurTime, 18, 2) < '20') then
begin
frmMain.RunTestTimer.Enabled := False;
rtConnect := Dialup(DM1.DSTdb.FieldByName('Tel').AsString);
If rtConnect = 1 then break;
end;
end;
//'Case 4 ####-##-## ##:46:00
if (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 6, 2) = '##') and (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 9, 2) = '##') and (Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 12, 2) = '##') then
begin
TimeStr := Copy(CurTime, 15, 2);
if (TimeStr = Copy(DM1.TestArgDB.FieldByName('rtTime').AsString, 15, 2)) and (Copy(CurTime, 18, 2) < '20') then
begin
frmMain.RunTestTimer.Enabled := False;
rtConnect := Dialup(DM1.DSTdb.FieldByName('Tel').AsString);
If rtConnect = 1 then break;
end;
end;
DM1.TestArgDB.Next;
end;
//Reading time hasn't been achieved, and exit
if (rtConnect = 0) then
begin
frmMain.RunTestTimer.Enabled := True;
exit;
end;
if Command.ListBox.Items.Count > 500 then Command.ListBox.Clear; // 'Clear list item
//'Immediately read meter
for i := 1 to 10 do
begin
if (DialRS232 = 0) and (not frmMain.MSComm.CDHolding) then
rtConnect := Dialup(DM1.DSTdb.FieldByName('TEL').AsString);
frmMain.MSComm.Output := Chr(13);
Command.ListBox.Items.Add('第一次循环:' + IntToStr(i));
Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;
frmmain.mscomm.inbuffercount:=0;
if ReadConcentrator then
begin
DumpData(DM1.TestArgDB.FieldByName('DNO').AsString, ReadTime, DataLen);
Command.ListBox.Items.Add('周期抄表完成.');
Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;
break;
end;
end;
frmMain.RunTestTimer.Enabled := True;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -