www.pudn.com > 电话产品防伪伺服系统(tw8).rar > Uform_main.pas
unit Uform_main;
interface
uses
tw8a32,uCreateCode,ShellAPI,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, ComCtrls, ToolWin, Menus, ExtCtrls, DB, ADODB, StdCtrls;
// StdCtrls, Grids, ComCtrls, Buttons, ExtCtrls, Menus, jpeg,
//ShlObj, ActiveX, ComObj ;
type
ring=record
funs:integer;
timeout:integer;
code:string;
thistime:tdatetime;
end;
Tform_main = class(TForm)
MainMenu1: TMainMenu;
N546541: TMenuItem;
N56456461: TMenuItem;
N5646541: TMenuItem;
ImageList1: TImageList;
Panel1: TPanel;
Image1: TImage;
ImageList2: TImageList;
fghf1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
wwwBeeShipcom1: TMenuItem;
N6: TMenuItem;
Email1: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
Timer1: TTimer;
Dconnect: TADOConnection;
statusbar1: TStatusBar;
H1: TMenuItem;
S1: TMenuItem;
C1: TMenuItem;
recordset_temp: TADOQuery;
tel_recordset: TADOQuery;
recordset_temp2: TADOQuery;
D1: TMenuItem;
N11: TMenuItem;
N21: TMenuItem;
StatusBar2: TStatusBar;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton7: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
ToolButton14: TToolButton;
ToolButton15: TToolButton;
S2: TMenuItem;
R1: TMenuItem;
C2: TMenuItem;
ToolButton16: TToolButton;
ToolButton17: TToolButton;
ToolButton18: TToolButton;
tel_recordset2: TADOQuery;
procedure Panel1Resize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure telser1(i:integer);
procedure telser2(i:integer);
procedure telser3(i:integer);
procedure telser4(i:integer);
procedure telser5(i:integer);
procedure telser6(i:integer);
procedure telser7(i:integer);
procedure telser8(i:integer);
procedure telser9(i:integer);
procedure telser10(i:integer);
procedure telser11(i:integer);
procedure telser12(i:integer);
procedure N11Click(Sender: TObject);
procedure N21Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure fghf1Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure S1Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure C1Click(Sender: TObject);
procedure R1Click(Sender: TObject);
procedure C2Click(Sender: TObject);
procedure wwwBeeShipcom1Click(Sender: TObject);
procedure Email1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
dd1:tdatetime;
dd2:tdatetime;
code1:string;
code2:string;
thisRing:array[1..2] of ring;
stop:array[1..2] of boolean;
ChNum:integer;
tt:CreateCode;
end;
var
form_main: Tform_main;
implementation
uses Uform_add_code, Uform_add_code2, Uform_code_edit,
Uform_code_del, Uform_bt_print, Uform_bt_output, Uform_his_show,
Uform_help, Uform_aboutme, Uform_his_del, Uform_record, Uform_record_pro;
{$R *.dfm}
procedure Tform_main.Panel1Resize(Sender: TObject);
begin
{* resize the form items' position 2001-12-17am*}
image1.Left :=panel1.Width div 2 - image1.Width div 2;
image1.Top:=panel1.Height div 2 - image1.Height div 2;
if (form_main.Width >200) then
begin
statusbar2.Panels [0].Width :=(form_main.Width-140) div 2;
statusbar2.Panels [1].Width :=(form_main.Width -140) div 2;
end;
end;
procedure Tform_main.FormCreate(Sender: TObject);
begin
{*int the connection 2001-12-17am*}
Dconnect.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='
+ExtractFilePath(ParamStr(0))
+'db\db.mdb;Persist Security Info=False';
stop[1]:=true;
stop[2]:=true;
end;
procedure Tform_main.ToolButton1Click(Sender: TObject);
begin
{*add the code form the buttonbar or the menu 2001-12-17*}
if statusbar1.Visible =true then exit;
{*show the form to chose the code that be created*}
form_add_code.SpinEdit3.Value :=0;
form_add_code.SpinEdit1.Value :=0;
form_add_code.SpinEdit2.Value :=0;
form_add_code.ShowModal;
if form_add_code.yesno =false then exit;
{*show the code that can not be created *}
form_add_code2.kind_code :=form_add_code.kind_code ;
form_add_code2.s_code := form_add_code.s_code ;
form_add_code2.e_code:=form_add_code.e_code;
form_add_code2.ShowModal ;
if form_add_code2.yesno =false then exit;
tt:=createcode.create(form_add_code.kind_code,form_add_code.s_code,form_add_code.e_code);
tt.Resume ;
exit;
end;
procedure Tform_main.Timer1Timer(Sender: TObject);
var
i:integer;
begin
//time detect 2001-12-17
statusbar2.Panels[2].Text :=datetimetostr(now);
for i:=1 to 2 do
if stop[i]=true then
begin
//time++
thisring[i].timeout :=thisring[i].timeout +1;
case thisring[i].funs of
1:
telser1(i);
2:
telser2(i);
3:
telser3(i);
4:
telser4(i);
5:
telser5(i);
6:
telser6(i);
7:
telser7(i);
8:
telser8(i);
9:
telser9(i);
10:
telser10(i);
11:
telser11(i);
12:
telser12(i);
end;
end
else
begin
statusbar2.Panels [i-1].Text :=inttostr(i) + '#号线停止工作';
end;
end;
procedure Tform_main.ToolButton2Click(Sender: TObject);
begin
//show the code edittion 2001-12-17
form_code_edit.ShowModal ;
end;
procedure Tform_main.FormActivate(Sender: TObject);
begin
//int the tw2a 2001-12-17
ChNum:=TW_Installed;
{if chnum=0 then
begin
showmessage('您没有安装TW2A电话语音卡');
close;
end; }
TW_Initialize;
thisring[1].funs:=1;
thisring[2].funs:=1;
thisring[1].timeout :=0;
thisring[2].timeout :=0;
end;
procedure Tform_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//end the software 2001-12-17
if ChNum>0 then
TW_Disable;
end;
//------------------------------------------------------------------------------------------------------------------------------------
//....................................................................................................................................
// telserver
//[[[[[[[[[[[[[[[[1]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser1(i:integer);
var
temp:pchar;
begin
//telephone server function1 2001-12-18
// wait the ring sound and play the welcome sound 2001-12-25p
statusbar2.Panels[i-1].Text :=inttostr(i) +'#线等待电话接入';
if tw_ringdetect(i-1) >1 then
begin
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线电话接入，正在播放欢迎音';
thisRing[i].funs :=2;
thisring[i].timeout :=0;
thisring[i].thistime :=now;
tw_offhookctrl(i-1);
tw_flushdtmf(i-1);
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\0sou.tw');
tw_startplayfile(i-1,temp,0,0);
end;
end;
//[[[[[[[[[[[[[[[[2]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser2(i:integer);
var
temp:pchar;
begin
//telephone server function2 2001-12-25p
//wait the welcome sound over or user press any key
tw_getdtmfstr(i-1,temp);
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线电话接入，正在播放欢迎音';
if ((tw_playfilerest(i-1)=0) or (length(temp)<>0)) then
begin
if tw_playfilerest(i-1)>0 then
begin
tw_stopplayfile(i-1);
end;
thisRing[i].funs :=3;
thisring[i].timeout :=0;
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线等待用户输入产品号码';
end;
if thisring[i].timeout =240 then
begin
thisRing[i].funs :=11;
showmessage('sss');
end;
end;
//[[[[[[[[[[[[[[[[3]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser3(i:integer);
var
temp:pchar;
begin
//telephone server function3 2001-12-25p
//wait the the user finish the press key
tw_getdtmfstr(i-1,temp);
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线等待用户输入产品号码';
if length(temp)>9 then
begin
if ((pos('*',temp)>0) or (pos('#',temp)>0)) then
begin
thisRing[i].funs :=10;
thisring[i].timeout :=0;
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线播放输入错误音';
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\17sou.tw');
tw_flushdtmf(i-1);
tw_startplayfile(i-1,temp,0,0);
end
else
begin
thisRing[i].funs :=4;
thisring[i].timeout :=0;
thisring[i].code :=temp;
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线播放号码确认音';
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\1sou.tw');
tw_flushdtmf(i-1);
tw_startplayfile(i-1,temp,0,0);
end;
end;
if thisring[i].timeout =240 then
begin
thisRing[i].funs :=11;
end;
end;
//[[[[[[[[[[[[[[[[4]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser4(i:integer);
var
temp:pchar;
begin
//telephone server function4 2001-12-25p
// 等待确认音放完
if tw_playfilerest(i-1)=0 then
begin
//0
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\2sou.tw');
tw_setvoicei(48,temp);
//1
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\3sou.tw');
tw_setvoicei(49,temp);
//2
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\4sou.tw');
tw_setvoicei(50,temp);
//3
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\5sou.tw');
tw_setvoicei(51,temp);
//4
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\6sou.tw');
tw_setvoicei(52,temp);
//5
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\7sou.tw');
tw_setvoicei(53,temp);
//6
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\8sou.tw');
tw_setvoicei(54,temp);
//7
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\9sou.tw');
tw_setvoicei(55,temp);
//8
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\10sou.tw');
tw_setvoicei(56,temp);
//9
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\11sou.tw');
tw_setvoicei(57,temp);
thisRing[i].funs :=5;
thisring[i].timeout :=0;
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线播放号码音';
tw_flushdtmf(i-1);
temp:=pchar(thisring[i].code);
tw_playsentence(i-1,temp);
end;
if thisring[i].timeout =240 then
begin
thisRing[i].funs :=11;
end;
end;
//[[[[[[[[[[[[[[[[5]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser5(i:integer);
var
temp:pchar;
begin
//telephone server function5 2001-12-25p
//等待号码音放完，然后放产品确认音
if tw_playsentencerest(i-1)=0 then
begin
thisRing[i].funs :=6;
thisring[i].timeout :=0;
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线放产品确认音';
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\12sou.tw');
tw_flushdtmf(i-1);
tw_startplayfile(i-1,temp,0,0);
end;
if thisring[i].timeout =240 then
begin
thisRing[i].funs :=11;
end;
end;
//[[[[[[[[[[[[[[[[6]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser6(i:integer);
var
p:integer;
temp:pchar;
begin
//telephone server function6 2001-12-25p
// 等待产品确认音，然后房产拼音
if tw_playfilerest(i-1)=0 then
begin
p:=strtoint(thisRing[i].code[1] + thisRing[i].code[2]);
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\' + inttostr(p+1) +'pro.tw');
if fileexists(ExtractFilePath(ParamStr(0)) + 'sound\' + inttostr(p+1) +'pro.tw')=false then
begin
thisRing[i].funs :=11;
exit;
end;
thisRing[i].funs :=7;
thisring[i].timeout :=0;
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线放产品名称音';
tw_flushdtmf(i-1);
tw_startplayfile(i-1,temp,0,0);
end;
if thisring[i].timeout =240 then
begin
thisRing[i].funs :=11;
end;
end;
//[[[[[[[[[[[[[[[[7]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser7(i:integer);
var
temp:pchar;
begin
//telephone server function7 2001-12-25p
//产品名称是否放完 ,然后放提示确认音
if tw_playfilerest(i-1)=0 then
begin
thisRing[i].funs :=8;
thisring[i].timeout :=0;
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线放提示确认音';
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\13sou.tw');
tw_flushdtmf(i-1);
tw_startplayfile(i-1,temp,0,0);
end;
if thisring[i].timeout =240 then
begin
thisRing[i].funs :=11;
end;
end;
//[[[[[[[[[[[[[[[[8]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser8(i:integer);
begin
//telephone server function8 2001-12-25p
//等待提示确认音放完活用户输入，然后进行处理
if tw_playfilerest(i-1)=0 then
begin
thisRing[i].funs :=9;
thisring[i].timeout :=0;
tw_flushdtmf(i-1);
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线等待用户输入确认信息';
end;
if thisring[i].timeout =240 then
begin
thisRing[i].funs :=11;
end;
end;
//[[[[[[[[[[[[[[[[9]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser9(i:integer);
var
temp:pchar;
temp2:pchar;
begin
//telephone server function9 2001-12-25p
//
tw_getdtmfstr(i-1,temp2);
if length(temp2)>0 then
begin
if temp2='1' then
begin
tel_recordset.SQL.Clear ;
tel_recordset.SQL.Add('select * from [CODE] where [CODE_CODE]=''' + thisring[i].code + '''' );
tel_recordset.Open ;
if tel_recordset.RecordCount =0 then
begin
thisRing[i].funs :=12;
thisring[i].timeout :=0;
dconnect.Execute('insert into [HIS]([HIS_CODE_KIND],[HIS_TEXT],[HIS_DT]) values(1,''' + thisring[i].code +''',#' + datetimetostr(thisring[i].thistime ) + '#)');
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线放错误音';
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\16sou.tw');
tw_flushdtmf(i-1);
tw_startplayfile(i-1,temp,0,0);
{tel_recordset2.SQL.Clear ;
tel_recordset2.SQL.Add('select * from [HIS]');
tel_recordset2.Open ;
tel_recordset2.Insert ;
tel_recordset2.Fields[1].AsInteger := 1;
tel_recordset2.Fields[2].AsString :=thisring[i].code;
tel_recordset2.Fields[3].AsDateTime :=thisring[i].thistime ;
tel_recordset2.Post ;
tel_recordset2.Close;}
end;
if tel_recordset.RecordCount>0 then
begin
if tel_recordset.Fields [4].AsBoolean =true then
begin
//已查询
thisRing[i].funs :=12;
thisring[i].timeout :=0;
dconnect.Execute('insert into [HIS]([HIS_CODE_KIND],[HIS_TEXT],[HIS_DT]) values(2,''' + thisring[i].code +''',#' + datetimetostr(thisring[i].thistime ) + '#)');
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线放已查音';
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\15sou.tw');
tw_flushdtmf(i-1);
tw_startplayfile(i-1,temp,0,0);
end
else
begin
//正确音
thisRing[i].funs :=12;
thisring[i].timeout :=0;
dconnect.Execute('update [CODE] set [CODE_CHECK]=true,[CODE_CHECK_DD]=#' + datetimetostr(thisring[i].thistime ) + '# where [CODE_CODE]=''' + thisring[i].code + '''');
dconnect.Execute('insert into [HIS]([HIS_CODE_KIND],[HIS_TEXT],[HIS_DT]) values(4,''' + thisring[i].code +''',#' + datetimetostr(thisring[i].thistime ) + '#)');
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线放正确音';
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\14sou.tw');
tw_flushdtmf(i-1);
tw_startplayfile(i-1,temp,0,0);
end;
end;
tel_recordset.Close ;
end;
if temp2='2' then
begin
//重新输入
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线电话接入，正在播放欢迎音';
thisRing[i].funs :=2;
thisring[i].timeout :=0;
tw_flushdtmf(i-1);
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\0sou.tw');
tw_startplayfile(i-1,temp,0,0);
end;
if ((temp2<>'1') and (temp2<>'2')) then
begin
//输入错误
thisRing[i].funs :=10;
thisring[i].timeout :=0;
statusbar2.Panels[i-1].Text :=inttostr(i) + '#线播放输入错误音';
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\17sou.tw');
tw_flushdtmf(i-1);
tw_startplayfile(i-1,temp,0,0);
end;
end;
if thisring[i].timeout =240 then
begin
thisRing[i].funs :=11;
end;
end;
//[[[[[[[[[[[[[[[[10]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser10(i:integer);
var
temp:pchar;
begin
//telephone server function10 2001-12-25p
//等待错误音放完
if tw_playfilerest(i-1)=0 then
begin
thisRing[i].funs :=2;
thisring[i].timeout :=0;
tw_flushdtmf(i-1);
temp:=pchar(ExtractFilePath(ParamStr(0)) + 'sound\0sou.tw');
tw_startplayfile(i-1,temp,0,0);
end;
if thisring[i].timeout =240 then
begin
thisRing[i].funs :=11;
end;
end;
//[[[[[[[[[[[[[[[[11]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser11(i:integer);
begin
//telephone server function11 2001-12-25p
//error or user off hook the telphone
thisRing[i].funs :=1;
tel_recordset.SQL.Clear ;
tel_recordset.SQL.Add('select * from [HIS]');
tel_recordset.Open ;
tel_recordset.Insert ;
tel_recordset.Fields[1].AsInteger := 1;
tel_recordset.Fields[2].AsString :=' ';
tel_recordset.Fields[3].AsDateTime :=thisring[i].thistime ;
tel_recordset.Post ;
tel_recordset.Close;
end;
//[[[[[[[[[[[[[[[[12]]]]]]]]]]]]]]]]]]]
procedure Tform_main.telser12(i:integer);
begin
//telephone server function12 2001-12-25p
//wait the the user finish the press key
if tw_playfilerest(i-1)=0 then
begin
thisRing[i].funs :=1;
thisring[i].timeout :=0;
tw_hangupctrl(i-1);
end;
if thisring[i].timeout =240 then
begin
thisRing[i].funs :=11;
end;
end;
//....................................................................................................................................
//------------------------------------------------------------------------------------------------------------------------------------
procedure Tform_main.N11Click(Sender: TObject);
begin
//start or stop #1 2001-12-18
stop[1]:= not stop[1];
if stop[1]=true then
begin
n11.Caption :='&1#线关闭服务';
thisring[1].funs :=1;
end
else
begin
n11.Caption :='&1#线开启服务';
tw_hangupctrl(0);
end;
end;
procedure Tform_main.N21Click(Sender: TObject);
begin
//stop or star #2 2001-12-18
stop[2]:= not stop[2];
if stop[2]=true then
begin
n21.Caption :='&2#线关闭服务';
thisring[2].funs :=1;
end
else
begin
n21.Caption :='&2#线开启服务';
tw_hangupctrl(1);
end;
end;
procedure Tform_main.N2Click(Sender: TObject);
begin
form_code_del.ShowModal ;
end;
procedure Tform_main.fghf1Click(Sender: TObject);
begin
form_bt_print.ShowModal ;
end;
procedure Tform_main.N3Click(Sender: TObject);
begin
form_bt_output.ShowModal ;
end;
procedure Tform_main.S1Click(Sender: TObject);
begin
form_his_show.ShowModal ;
end;
procedure Tform_main.N5Click(Sender: TObject);
begin
form_help.ShowModal ;
end;
procedure Tform_main.N8Click(Sender: TObject);
begin
form_aboutme.ShowModal ;
end;
procedure Tform_main.C1Click(Sender: TObject);
begin
form_his_del.ShowModal ;
end;
procedure Tform_main.R1Click(Sender: TObject);
var
temp1:boolean;
temp2:boolean;
begin
temp1:=stop[1];
stop[1]:=false;
tw_hangupctrl(0);
temp2:=stop[2];
stop[2]:=false;
tw_hangupctrl(1);
form_record.ShowModal ;
stop[1]:=temp1;
thisring[1].funs :=1;
stop[2]:=temp2;
thisring[2].funs :=1;
end;
procedure Tform_main.C2Click(Sender: TObject);
var
temp1:boolean;
temp2:boolean;
begin
temp1:=stop[1];
stop[1]:=false;
tw_hangupctrl(0);
temp2:=stop[2];
stop[2]:=false;
tw_hangupctrl(1);
//show the form _ record_ pro 2001-12-25p
form_record_pro.ShowModal ;
stop[1]:=temp1;
thisring[1].funs :=1;
stop[2]:=temp2;
thisring[2].funs :=1;
end;
procedure Tform_main.wwwBeeShipcom1Click(Sender: TObject);
begin
ShellExecute(Self.Handle,'Open',PChar('http://www.beeship.com'),nil,nil,1);
end;
procedure Tform_main.Email1Click(Sender: TObject);
begin
ShellExecute(Self.Handle,'Open',PChar('mailto:PianoPan@Beeship.com?Subject=关于电话伺服系统1.0'),nil,nil,1);
end;
end.