⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 global.pas

📁 Monitor.dfm Meter.dpr pasMain.pas
💻 PAS
📖 第 1 页 / 共 2 页
字号:
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 + -