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

📄 autotest.pas

📁 Monitor.dfm Meter.dpr pasMain.pas
💻 PAS
字号:
unit autotest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls,db, Buttons;

type
  TfrmTestArg = class(TForm)
    Work_btn: TButton;
    Button2: TButton;
    Button4: TButton;
    Button5: TButton;
    Timer1: TTimer;
    ListView1: TListView;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    editdno: TEdit;
    editname: TEdit;
    Label3: TLabel;
    Label2: TLabel;
    editnum: TEdit;
    edittelno: TEdit;
    Label4: TLabel;
    GroupBox2: TGroupBox;
    List1: TListBox;
    GroupBox3: TGroupBox;
    edittime: TEdit;
    List2: TListBox;
    btnAddTime: TButton;
    btnConnectMode: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure btnAddTimeClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Work_btnClick(Sender: TObject);
    procedure List1Click(Sender: TObject);
    procedure List1DblClick(Sender: TObject);
    procedure List2Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnConnectModeClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmTestArg: TfrmTestArg;

implementation

uses DM, pasMain, ReadData,global, InterCom;

{$R *.DFM}
procedure TfrmTestArg.FormCreate(Sender: TObject);
var
    ListItem: TListItem;
begin

    if DialRS232 = 0 then
        btnConnectMode.Caption := '连接方式: Modem'
    else
        btnConnectMode.Caption := '连接方式: RS232';

    listview1.Items.Clear ;
    DM1.DSTdb.First;
    while not DM1.DSTdb.Eof do
    with ListView1 do
    begin
        ListItem := Items.add;
        ListItem.Caption := DM1.DSTdb.FieldByname('DNO').AsString;
        ListItem.ImageIndex := -1;
        ListItem.SubItems.add(DM1.DSTdb.FieldByname('NAME').AsString);

        ListItem.SubItems.add(DM1.DSTdb.FieldByname('NMB').AsString);
        ListItem.SubItems.add(DM1.DSTdb.FieldByname('TEL').AsString);
        DM1.DSTdb.Next;
    end;

    list2.Items.Clear ;
    List2.items.Add('0');
    List2.items.Add('1');
    List2.items.Add('2');
    List2.items.Add('3');
    List2.items.Add('4');
    List2.items.Add('5');
    List2.items.Add('6');
    List2.items.Add('7');
    List2.items.Add('8');
    List2.items.Add('9');
    List2.items.Add('-');
    List2.items.Add(' ');
    List2.items.Add(':');
    List2.items.Add('##');
    List2.items.Add('####');

    DM1.TestArgDB.First;
    if DM1.TestArgDB.Eof then exit;
    if DM1.DSTDB.Locate('DNO',DM1.TestArgDB.FieldByName('DNO').AsString,[loCaseInsensitive]) then
    begin
        EditdNO.Text := DM1.DSTDB.FieldByName('DNO').AsString;
        EditName.Text := DM1.DSTDB.FieldByName('NAME').AsString;
        EditNum.Text := DM1.DSTDB.FieldByName('NMB').AsString;
        EditTelNO.Text := DM1.DSTDB.FieldByName('TEL').AsString;
    end;

    List1.Items.Clear ;
    while not DM1.TestArgDB.Eof do
    begin
        List1.items.Add(DM1.TestArgDB.FieldByName('RTTime').AsString);
        DM1.TestArgDB.Next ;
    end;

    frmTestArg.Left := ( Screen.Width - frmTestArg.Width ) div 2;
    frmTestArg.Top := ( Screen.Height - frmTestArg.Height ) div 2;
end;


procedure TfrmTestArg.Button5Click(Sender: TObject);
begin
    close;
end;


procedure TfrmTestArg.Button2Click(Sender: TObject);
begin
    List1.Clear;
    EditDNO.Text :='';
    EditName.Text :='';
    EditNum.Text :='';
    EditTelNO.Text :='';

    DM1.TestArgDB.First;
    if DM1.TestArgDB.eof then exit;
    frmTestArg.Cursor := crHourGlass;
    if DM1.DSTDB.Locate('DNO',DM1.TestArgDB.FieldByName('DNO').AsString,[loCaseInsensitive]) then
    begin
        EditDNO.Text := DM1.DSTDB.FieldByName('DNO').AsString;
        EditName.Text := DM1.DSTDB.FieldByName('Name').AsString;
        EditNum.Text := DM1.DSTDB.FieldByName('NMB').AsString;
        EditTelNO.Text := DM1.DSTDB.FieldByName('TEL').AsString;
    end;

    while not dm1.testargdb.Eof do
    begin
        List1.Items.Add(DM1.TestArgDB.FieldByName('RTTime').AsString);
        DM1.TestArgDB.Next ;
    end;

    frmTestArg.Cursor := crDefault;

end;


procedure TfrmTestArg.btnAddTimeClick(Sender: TObject);
begin
    If Length(edittime.Text) = 19 Then List1.items.Add(EditTime.Text);
end;


procedure TfrmTestArg.Button4Click(Sender: TObject);
var
    i: Integer;
begin
    If (EditdNO.Text = '') or (EditTelNO.Text = '') or (List1.items.Count = 0) then Exit;

    frmTestArg.Cursor := crHourGlass;

    //delete TestaagDB;
    with DM1.Backup do
    begin
        Close;
        SQL.Clear;
        SQL.Add('DELETE FROM TestArg');
        ExecSQL;
    end;

    for i := 0 to  List1.items.count - 1 do
    with DM1.TestArgDB do
    begin
        Append;
        FieldByName('DNO').AsString := EditDNO.Text;
        FieldByName('RTTime').AsString := List1.items.strings[i];
        Post;
        FlushBuffers;
        refresh;
    end;

    frmTestArg.Cursor := crDefault;

end;


procedure TfrmTestArg.Work_btnClick(Sender: TObject);
begin
    if Timer1.Enabled = FALSE then
    begin
        Timer1.Enabled := True;
        Work_btn.Caption := '停止测试' ;
    end
    else
    begin
        Timer1.Enabled := FALSE;
        
        Work_btn.Caption := '启动测试';
    end;
end;


procedure TfrmTestArg.List1Click(Sender: TObject);
var
    i: Integer;
begin

    for i := 0 to (List1.Items.Count - 1) do begin
    try
        if List1.Selected[i] then
            EditTime.Text := List1.Items.Strings[i];
    finally
   { do something here }
   end;
end;

end;


procedure TfrmTestArg.List1DblClick(Sender: TObject);
var
    i: Integer;
begin
    for i := 0 to (List1.Items.Count - 1) do
    try
        if List1.Selected[i] then
        begin
            List1.Items.Delete(i);
            exit;
        end;
    finally;
    { do something here }
    end;
end;


procedure TfrmTestArg.List2Click(Sender: TObject);
begin
    EditTime.Text := EditTime.Text + List2.Items.Strings[(List2.ItemIndex)];
end;


procedure TfrmTestArg.ListView1DblClick(Sender: TObject);
begin
    if DM1.dstdb.Locate('dno',frmtestarg.listview1.items[(ListView1.Selected.index)].Caption ,[loCaseInsensitive]) then
    begin
        editdno.Text :='';
        editname.Text :='';
        editnum.Text :='';
        edittelno.Text :='';

        editdno.Text := dm1.dstdb.fieldbyname('dno').asstring;
        editname.Text := dm1.dstdb.fieldbyname('name').asstring;
        editnum.Text := dm1.dstdb.fieldbyname('nmb').asstring;
        edittelno.Text := dm1.dstdb.fieldbyname('tel').asstring;
    end;
end;

procedure TfrmTestArg.Timer1Timer(Sender: TObject);
var
    TmpStr,buf,tmpbuf: String;
    i:integer;
label dialloop;

begin

    for i := 0 to List1.Items.Count - 1 do
    begin
        List1.ItemIndex := i;
        if EditTelNO.Text <> '' then
        begin
            TmpStr := CurTime;
            if TmpStr = Copy(List1.Items.Strings[i], 1, 16) then
            begin
                If DM1.Protocaldb.Eof then exit;

                Timer1.Enabled := FALSE;

                //Dial telephone
DialLoop:       frmMain.MSComm.Output := 'ATDT' + EditTelNO.Text + Chr(13);
                //'Detect Carrier Signal
                frmMain.MSComm.RThreshold := 0;
                frmMain.MSComm.InputLen := 1;

                Timing := 0;
                Timer1.Enabled := TRUE;

                Command.ListBox.Items.Add('正在拨号,请等待...');
                Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;

                TmpBuf :='';
                while TRUE do
                begin
                    if not ActiveCommand then break;
                    Application.ProcessMessages;
                    if not ActiveCommand then break;
                    if Timing =1 then break;

                    If frmMain.MSComm.InBufferCount >= 1 Then
                    begin
                        buf := frmMain.MSComm.Input;
                        tmpbuf := tmpbuf + buf;
                        If buf = Chr(13) Then
                        begin
                            Command.ListBox.Items.Add(TmpBuf);
                            Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;
                            break;
                    end;
                end;

            end; //End if

            Timer1.Enabled := FALSE;
            If Timing = 1 Then
            begin
                Command.ListBox.Items.Add('Dial Time Out!');
                Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;
                goto DialLoop
            end;

            Timing := 0;
            Timer1.Enabled := True;
            while True do
            begin
                if not ActiveCommand then break;
                Application.ProcessMessages;
                if not ActiveCommand then break;
                If Timing = 1 Then break;
                If frmMain.MSComm.CDHolding then
                begin
                    Command.ListBox.Items.Add('数据链路已经建立!');
                    Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;
                    break;
                end;
            end;

            Timer1.Enabled := False;
            If Timing = 1 then
            begin
                Command.ListBox.Items.Add('拨号异常!');
                Command.ListBox.ItemIndex := Command.ListBox.Items.Count - 1;
                goto DialLoop
            end;

            exit;
        end;
    end;
end;

end;


procedure TfrmTestArg.btnConnectModeClick(Sender: TObject);
begin
   if DialRS232 = 0 Then
    begin
        DialRS232 := 1;
        btnConnectMode.Caption := '连接方式: RS232';
    end
    else
    begin
        DialRS232 := 0;
        btnConnectMode.Caption := '连接方式: Modem';
    end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -