📄 autotest.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 + -