delphi2007 教程

unit UntCall; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,tAPI, Buttons, ComCtrls, ExtCtrls, DB, ADODB,StrUtils, Menus,MMSystem, DBTables, Mask; Const Handle_Use_Default=0; type TFrm_Call = class(TForm) Label1: TLabel; edt_ComPort: TEdit; Label2: TLabel; edt_phone: TEdit; cmd_Start: TBitBtn; Label3: TLabel; edt_Time: TEdit; Label4: TLabel; TrackBar1: TTrackBar; cmd_Stop: TBitBtn; Timer_Run: TTimer; ListBox1: TListBox; Timer_ShutDown: TTimer; ADOQuery_A: TADOQuery; Label5: TLabel; edt_SoundTime: TEdit; PopupMenu1: TPopupMenu; N1: TMenuItem; N2: TMenuItem; SaveDialog1: TSaveDialog; MainMenu1: TMainMenu; GroupBox1: TGroupBox; RadioButton_AT: TRadioButton; RadioButton_tAPI: TRadioButton; Timer_Play: TTimer; AdoQuery_W: TQuery; edt_WaveFile: TEdit; cmd_GetWaveFile: TSpeedButton; OpenDialog1: TOpenDialog; cmd_Firm: TBitBtn; chk_ShutDown: TCheckBox; edt_ShutDownTime: TMaskEdit; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); procedure cmd_StartClick(Sender: TObject); procedure cmd_StopClick(Sender: TObject); procedure Timer_RunTimer(Sender: TObject); procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure Timer_PlayTimer(Sender: TObject); procedure cmd_GetWaveFileClick(Sender: TObject); procedure cmd_FirmClick(Sender: TObject); procedure Timer_ShutDownTimer(Sender: TObject); private fPhone:string; fName:string; fCallStatus:Cardinal; fWaveFile:string; public Function ReadInfoFromDataLoop(var sPhone,sName:string):Boolean; Function APIDialTest:Boolean; //tapi拨号测试 Function APIDialPrepare:Boolean; //拨号准备线路 Function APIDial(const sPhone:string=''):Boolean; //API拨号MakeCall Function APIGetCallStatus(var dwState:Cardinal):Boolean; //API的获取当前拨号状态 Function APIStartCall(const sPhoneNumber:string=''):Boolean; //整体拨号 Function APIStopCall(const nTimeOut:Cardinal=50):Boolean; //停止拨号 Function ATInitlizeModem:Boolean; //AT初始化拨号 Function ATCall(const sPhone:string=''):Boolean; //AT的拨号程序 Function DoAtCommand(const sATCommand:string='';hFileHandle:tHandle=Handle_Use_Default):Boolean; Procedure ShowModemStatusInfo; //显示MODEM状态信息 Procedure ShowInfo(const sMsg:string='';lShowTime:Boolean=True;lMessageBox:Boolean=False); Function BuildRegistInfo(var sMachine,sKey:string):Boolean; Function ReadConfig(sKey:string;vValue:Variant):Boolean; End; var Frm_Call: TFrm_Call; LineApp:hLineApp; //tAPI句柄 Line:HLine; //线路句柄 LineID:dWord; //GetLineID的返回 Call:HCall; //呼叫句柄 CallParams:tLineCallParams; //线路呼叫参数 nDevs,APIVersion,ErrorCode:dWord; //线路设备数，版本号，错误代码 AddressID:Cardinal; //地址号 extID:tLineExtensionID; //tAPI扩展版本号 LineIcon:HIcon; //线路设备图标 hCommFile:tHandle; //使用AT时候的文件句柄 ModemStatus:dWord; //Modem状态随时保存进来 NumberWritten:dWord; //写入串口的字符数量 WaveOut:hWaveOut; //声音输出 WaveFormat:pWaveFormatEX; //PCMWAVEFORMAT; //声音类型 WaveHead:WaveHDR; //声音头 xWaveDevice:tHandle; //声音输出设备 xData:hGlobal; //数据保存 pData:^Byte; //真正的数据保存区，指针 SndDataSize:dWord; //播放的数据缓冲区的大小 SndPlayTime:MMTime; //播放的时间信息 SndWaveFile:string; //要播放的声音文件 PlaySignal:Boolean; //正在播放的标志 xHandle:dWord; //保存句柄 xInstance:Cardinal; //保存自身 DialRunType:Cardinal; //拨号类别:1=循环拨号,2=固定拨号 Procedure LineCallBack(hDevice,dwMsg,dwCallBackInstance, dwParam1,dwParam2,dwParam3:LongInt);stdCall; Procedure WaveOutProc(hwo:HWAVEOUT; uMsg,dwInstance,dwParam1,dwParam2:DWORD);StdCall; Function OpenWaveFile(sFile:string):dWord; //打开文件准备 Function PlayWaveFile(hHandle:Hwnd):dWord; //播放声音文件 Function StopPlay:Boolean; //停止播放文件，但没有关闭 Function ClosePlay:Boolean; //最终关闭播放 Function Interchange(hpchPos1, hpchPos2 : PChar; wLength : word):Boolean; //数据区对调 implementation Uses UntMDI; {$R *.dfm} //============================================================================// //---------------获取系统注册信息,写入sMachine/sKey-----------------// Function tFrm_Call.BuildRegistInfo(var sMachine,sKey:string):Boolean; var xMachine,xKey:String; Begin Result:=False; End; //-------------------读取系统设置-----------------------// Function tFrm_Call.ReadConfig(sKey:string;vValue:Variant):Boolean; Begin Result:=False; End; //---------------------拨号---------------------// Function tFrm_Call.APIStartCall(const sPhoneNumber:string=''):Boolean; //拨号 Begin Result:=False; if trim(sPhoneNumber)='' then exit; if not APIDialTest then exit; if not APIDialPrepare then exit; if not APIDial(sPhoneNumber) then exit; Result:=True; End; //--------------------停止拨号-----------------// Function tFrm_Call.APIStopCall(const nTimeOut:Cardinal=50):Boolean; //停止拨号 Begin Result:=False; LineClose(Line); LineShutDown(LineApp); Result:=True; End; //----------获取拨号线路设备ID----------------// Function GetWaveDeviceID:dWord; var nState,nNeedSize,nLen:dWord; xVarString:pVarString; xValue:pChar; Begin Result:=0; nLen:=8; //用来保存ID的长度 nNeedSize:=SizeOf(varString)+nLen; While True do begin //因为缓冲区可能小 GetMem(xVarString,nNeedSize); //分配内存区，注意：此处需为VarString而不是他的指针！！ xVarString.dwTotalSize:=nNeedSize; //初始化变量 StringFormat_Binary nState:=LineGetID(Line,AddressID,Call,LINECALLSELECT_Call,xVarString,'wave/out'); //成功返回0；2147483725 = STRUCTURETOOSMALL if xVarString.dwTotalSize>=xVarString.dwNeededSize then Break; //重新分配内存区 if (nState<>LINEERR_STRUCTURETOOSMALL) and (nState<>0) then Exit; nNeedSize:=xVarString.dwNeededSize+nLen; FreeMem(xVarString); End; //dwWaveDev = (DWORD) * ((DWORD *) ((LPSTR)vs + vs->dwStringOffset) ); //Result:=PHandle(LpStr(xVarString)[xVarString.dwStringOffset])^; Try GetMem(xValue,xVarString^.dwStringSize); Move( pChar(xVarString)[xVarString^.dwStringOffset],xValue^,xVarString^.dwStringSize); //xVarString^.dwStringOffset Result:=dWord(xValue^); Finally FreeMem(xValue); FreeMem(xVarString); End; { Inc(xVarString,xVarString^.dwStringOffset); Result:=(pDWord(xVarString))^; Dec(xVarString,xVarString^.dwStringOffset); } {About Params named 'DeviceClass' of LineGetID: If you want to play audio over the phone line, you should specify "wave/out"; if you want to record audio, use "wave/in".} End; //-----------------打开声音文件并准备之-----------------------// Function OpenWaveFile(sFile:string):dWord; Type _PInfo=Record //播放格式的结构 FileName:string; FCC:FourCC; End; Var xMMIO:hMMIO; xMMIOInfo:pMMIOInfo; pInfo,cInfo:MMCKINFO; //实例化变量 nValue:dWord; Pt1,Pt2:pChar; Label Error_Exit; Begin Result:=0; pData:=0; xData:=0; if not FileExists(sFile) then exit; //分配内存区 GetMem(xMMIOInfo,sizeof(tMMIOInfo)); if WaveFormat=nil then GetMem(WaveFormat,sizeof(tWaveFormatEX)); //打开文件 xMmio:=mmioOpen(pChar(sFile),0,MMIO_READ); //xMMIOInfo Nil if xMMIO=NULL then GOTO Error_Exit; //成功返回句柄，失败返回NULL //查找WAVE格式的父块Wave pInfo.fccType:=mmioStringToFourCC('wave',mmio_ToUpper); if mmioDescend(xMmio,@pinfo,Nil,MMIO_FindRiff)<>MMSYSERR_NOERROR then goto Error_Exit; //进入FMT块 cInfo.cksize:=16; cInfo.ckid:=mmioStringToFourCC('fmt ',0); //此处注意大小写! mmioFOURCC if mmioDescend(xMMIO,@cInfo,@pInfo,MMIO_FindChunk)<>MMSysErr_NoError then goto Error_Exit; //MMIOERR_CHUNKNOTFOUND //读取文件格式 nValue:=cInfo.cksize; //文件格式大小 GetMem(WaveFormat,nValue); //重新分配内存 if (mmioRead(xMMIO,pChar(WaveFormat),nValue)<>nValue) then goto Error_Exit;//读取文件头格式的字节数填充，到了文件底部或字节数不足返回0，错误返回－1，正确返回字节数 if WaveFormat^.wFormatTag<>Wave_Format_PCM then goto Error_Exit; if mmioAscend(xMMIO,@cInfo,0)<>MMSysErr_NoError then goto Error_Exit; //跳 //查找DATA数据块 cInfo.ckid:=mmioStringToFourCC('data',0); if mmioDescend(xMMIO,@cInfo,@pInfo,mmio_FindChunk)<>MMSysErr_NoError then goto Error_Exit; sndDataSize:=cInfo.cksize; //数据区大小 //下面将读取数据 xData:=GlobalAlloc(GMEM_MOVEABLE + GMEM_SHARE,SndDataSize); //分配内容并设置其属性 pData:=GlobalLock(xData); //锁定内存区，并返回地址 if mmioRead(xMMIO,pChar(pData),SndDataSize)<>SndDataSize then goto Error_Exit; {//特殊情况的处理：数据区块前后对调 nValue:=WaveFormat^.nBlockAlign; Pt1:=pChar(pData); Pt2:=pChar(pData) + SndDataSize - 1; While Pt1 < Pt2 do begin InterChange(Pt1,Pt2,nValue); //数据交换 Inc (Pt1, nValue); //+ Dec (Pt2, nValue) //- end; } //设置播放的声音头信息，里边包含需要播放的缓冲区地址、长度等 WaveHead.lpData:=pChar(pData); //数据源指针 WaveHead.dwBufferLength:=sndDataSize; //数据缓冲区大小 WaveHead.dwFlags:=0; WaveHead.dwLoops:=3; WaveHead.dwUser:=0; //完成了，关闭MMIO mmioClose(xMMIO,mmio_FHOpen); //清理内存区 FreeMem(xMMIOInfo); Result:=SndDataSize; //成功返回字节数 Exit; Error_Exit: ErrorCode:=$FFFF; //设置错误标志 FreeMem(xMMIOInfo); FreeMem(WaveFormat); if pData<>nil then LocalUnLock(xData); //xData if xData<>Null then GlobalFree(xData); //释放获取的全局锁定内存 End; //-------------播放声音文件------------------------------------// Function PlayWaveFile(hHandle:Hwnd):dWord; var nValue:dWord; label Error_Exit; Begin Result:=0; if WaveFormat=Nil then GetMem(WaveFormat,sizeof(tWaveFormatEX)); //分配内存区 //检测是否能够播放，此处phWaveOut可以是Null，设备ID可以是Wave_Mapper nValue:=WaveOutOpen(0,xWaveDevice,WaveFormat,0,0,Wave_Format_Query); //xWaveDevice,格式查询LineMapper IF nValue<>MmSysErr_NoError then goto Error_Exit; //mmSysErr_NoError=0 //设置回调处理函数&窗口并测试 nValue:=WaveOutOpen(@WaveOut,xWaveDevice,WaveFormat,Cardinal(@WaveOutProc),xInstance,CallBack_Function); if nValue<>mmSysErr_NoError then Exit; //通知输出设备准备好数据结构头 nValue:=WaveOutPrepareHeader(WaveOut,pWaveHDR(@WaveHead),sizeof(WaveHead)); if nValue<>mmSysErr_NoError then exit; //最终写入输出设备 nValue:=WaveOutWrite(WaveOut,@WaveHead,sizeof(WaveHDR)); if nValue<>mmSysErr_NoError then exit; PlaySignal:=True; Result:=1; Error_Exit: if WaveFormat<>Nil then FreeMem(WaveFormat); if Result=0 then Messagebox(xHandle,'[PlayWaveFile]播放文件失败,可能格式错误、线路错误等。请检查！','播放错误',32); if Result=0 then setLastError(11255); End; //-------------------停止播放，但没关闭------------------------// Function StopPlay:Boolean; Begin Result:=( WaveOutReset(WaveOut)<>mmSysErr_NoError ); End; //------------------全部停止，释放资源-------------------------// Function ClosePlay:Boolean; Begin Result:=False; //如果没有释放，则此处释放之 if WaveOut<>Null then Try WaveOutReset(WaveOut); //重置，释放 WaveOutClose(WaveOut); //关闭，包括文件 WaveOutUnPrepareHeader(WaveOut,@WaveHead,sizeof(WaveHDR)); Except Exit; End; //释放锁定的内存区 GlobalUnLock(xData); //撤销内存锁定 GlobalFree(xData); //释放全局内存 //结束 Result:=True; End; //----------------声音处理的回调函数---------------------------// Procedure WaveOutProc(hwo:HWAVEOUT; uMsg,dwInstance,dwParam1,dwParam2:dWORD);StdCall; Begin Case uMsg of WOM_DONE: //播放完毕了，WaveOutWrite函数触发 Begin PlaySignal:=True; ClosePlay; //停止播放 End; WOM_CLOSE: //当WaveOutClose函数完毕时触发 Begin PlaySignal:=False; End; WOM_Open: //WaveOutOpen函数 Begin PlaySignal:=True; End; Else Begin End; End; End; //----------------------回调处理的主函数----------------------------------// {tAPI异步呼叫返回处理函数，因为窗口隐藏，所以这里处理返回的消息} Procedure LineCallBack(hDevice,dwMsg,dwCallBackInstance, dwParam1,dwParam2,dwParam3:LongInt);stdCall; var lCall:HCall; Buffer:pChar; begin With untCall.Frm_Call do begin if dwParam2<0 then Begin ShowInfo('LineCallBack:呼叫响应错误！'); Exit; END; //-----根据dwMessage的消息类别判断 Case dwMsg of Line_Reply: //LineMakeCall结果，Relay：答复 Begin //ShowMessage('Line_Reply!!!拨叫成功,写入呼叫句柄Call成功'); End; Line_CallState: //返回呼叫状态时的处理 Begin lCall:=hCall(hDevice); //类型转换 Case dwParam1 of //类型值 LineCallState_IDLE: //呼叫无效 Begin ShowInfo('呼叫无效，断开'); if Call<>0 then LineDealLocateCall(lCall); //呼叫无效，断开 End; LineCallState_Connected: //连接成功 Begin ShowInfo('LineCallState_Connected!'); //获取线路设备ID xWaveDevice:=GetWaveDeviceID(); if xWaveDevice=0 then exit; //播放声音 if OpenWaveFile(SndWaveFile)=0 then exit; PlayWaveFile(xHandle); End; Line_MonitorDigits: //接收用户按键 Begin //ShowMessage('Line_MonitorDigits'); ShowInfo('接收用户按键。。。。。。'); End; LineCallState_Accepted: //用户接收了连接:此处不对！ Begin //ShowMessage('LineCallState_Accepted'); //ShowInfo('用户接收了连接！'); End; LineCallState_Offering: //对方要求应答 Begin //ShowMessage('LineCallState_Offering'); End; LINECALLSTATE_BUSY: //占线忙音 Begin //ShowMessage('LineCallState_Busy'); ShowInfo('占线。。。。。。'); End; LineCallState_Proceeding: //正常处理的 Begin //ShowMessage('LineCallState_Procedding'); ShowInfo('正在处理Proceeding......'); End; LineCallState_DialTone: //检测到拨号音 Begin //ShowMessage('LineCallState_DialTone'); ShowInfo('检测到拨号音'); End; LineCallState_Dialing: //正在拨号中 Begin //ShowMessage('LineCallState_Dialing'); End; LineCallState_DisConnected: //断开连接 Begin //ShowMessage('LineCallState_Disconnected'); PlaySignal:=False; End; Else END; End; Line_LineDevState: Begin Case dwParam1 of LineDevState_Connected: //连接完毕 Begin //ShowMessage('线路设备连接成功!LineDevState_Connected'); ShowInfo('线路设备连接成功！'); End; LINEDEVSTATE_RINGING: //正在拨号响声 Begin //ShowMessage('线路设备正在响铃LineDevState_Ring'); ShowInfo('正在响铃Ring'); End; LINEDEVSTATE_DISCONNECTED: //断开连接 Begin //ShowMessage('线路设备断开!LineDevState_DisConnected'); End; Else Begin End; End; End; End; end; End; //--------------------TAPI拨号准备:版本检查等--------------------------// Function tFrm_Call.APIDialTest:Boolean; Begin Result:=False; If LineInitialize(@LineApp,HInstance,@LineCallBack,'海宏拨号程序',nDevs)<0 then //初始化线路 ShowInfo('线路初始化失败，请检查线路',True,True) Else If nDevs=0 then //没有TAPI线路设备 Begin LineShutDown(LineApp); LineApp:=0; End Else //协商TAPI版本号 1.4~3.0 If LineNegotiateAPIVersion(LineApp,0,$00010004,$00030000, APIVersion,extID)>=0 then Result:=True //成功 Else Begin ShowInfo('TAPI版本不兼容！1.4~3.0',True,True); LineShutDown(LineApp); LineApp:=0; End; End; //---------------------tAPI拨号准备:打开线路等---------------------------// function tFrm_Call.APIDialPrepare:Boolean; Begin Result:=False; with UntCall.CallParams do //设置呼叫参数 Begin callParams.dwTotalSize:=sizeof(CallParams); //大小 callParams.dwBearerMode:=LineBearerMode_Voice; //语音承载模式 CallParams.dwMediaMode:=LineMediaMode_InteractiveVoice; //媒体模式为交换式语音 CallParams.dwNoAnswerTimeout:=StrToIntDef(self.edt_Time.Text,20000); //没有应答的等待时间 //CallParams.dwAddressMode:=LINEADDRESSMODE_DIALABLEADDR; //任何可以拨号的地址,LineOpen拨号不能用LINEADDRESSMODE_AddressID End; if True then Begin //打开线路 //应答方需要：用LINECALLPRIVILEGE_MONITOR+LINECALLPRIVILEGE_OWNER //呼叫方需要：LineCallPrivilege_None ErrorCode:=LineOpen(LineApp,LineMapper,@Line,APIVersion,0,0, LineCallPrivilege_None,LineMediaMode_InteractiveVoice, @CallParams); //LineMediaMode_InteractiveVoice / LINEMEDIAMODE_AUTOMATEDVOICE if ErrorCode<0 then ShowInfo('线路不能打开！',True,True) else Begin //LineConfigDialog(0,self.Handle,Nil); //线路设备属性对话框 LineGetIcon(0,'tapi/line',@LineIcon); //线路图标句柄，可辅给tICON.Handle End; End; Result:=True; End; //--------------------------拨号-----------------------------// Function tFrm_Call.APIDial(const sPhone:string=''):Boolean; Begin Result:=False; if sPhone='' then exit; ErrorCode:=LineMakeCall(Line,@call,pchar(sPhone),0,@CallParams); if ErrorCode<0 then showmessage('呼叫失败！') else begin //拨通，提示摘机通话 //Sleep(StrToIntDef(self.edt_Time.Text,12500) ); ErrorCode:=LineGetAddressID(Line,AddressID,CallParams.dwAddressMode,pChar(sPhone),Length(sPhone)); Result:=True; End; End; //-------------获取API拨号的状态---------------------------// Function tFrm_Call.APIGetCallStatus(var dwState:Cardinal):Boolean; //API的获取当前拨号状态 Var CallStatus:pLineCallStatus; nValue,nNeedSize:Cardinal; Begin Result:=False; if Call=0 then exit; nNeedSize:=sizeof(tLineCallStatus); While True Do Begin GetMem(CallStatus,nNeedSize); CallStatus^.dwTotalSize:=nNeedSize; nValue:=LineGetCallStatus(Call,CallStatus); if (nValue<>0) and (nValue<>LINEERR_STRUCTURETOOSMALL) then Exit; if CallStatus^.dwNeededSize <= CallStatus^.dwTotalSize then Break; nNeedSize:=CallStatus^.dwNeededSize; FreeMem(CallStatus); End; nValue:=CallStatus^.dwCallState; //状态 dwState:=nValue; FreeMem(CallStatus); Result:=True; End; //---------------从数据库循环读取信息,写入fPhone/fName---------------------// Function tFrm_Call.ReadInfoFromDataLoop(var sPhone,sName:string):Boolean; //传址 var xName,xPhone:string; Begin Result:=False; xPhone:=''; xName:=''; if DialRunType=2 then begin sPhone:=edt_Phone.Text; sName:='固定拨号'; Result:=True; Exit; End; If AdoQuery_W.Eof then Try AdoQuery_W.First; Except ShowInfo('移动数据库记录错误，终止'); Exit; End; If not AdoQuery_W.Eof then Try if AdoQuery_W.FieldValues['sPhone']<>NULL then xPhone:=Trim(AdoQuery_W.FieldValues['sPhone']); if AdoQuery_W.FieldValues['sName']<>NULL then xName:=Trim(AdoQuery_W.FieldValues['sName']); ShowInfo('读取数据：[名称='+xName+']；[电话='+xPhone+']'); sPhone:=xPhone; sName:=xName; AdoQuery_W.Next; //数据库记录下移 Except ShowInfo('提取数据库电话、名称数据失败！'); Exit; End; fName:=xName; fPhone:=xPhone; //同时记录下来 Result:=True; End; //--------------------------数据区交换------------------------------// Function Interchange(hpchPos1, hpchPos2 : PChar; wLength : word):Boolean; Var wPlace : word; bTemp : char; Begin Result:=False; for wPlace := 0 to wLength - 1 do begin bTemp := hpchPos1[wPlace]; hpchPos1[wPlace] := hpchPos2[wPlace]; hpchPos2[wPlace] := bTemp End; Result:=True; End; //----------------------显示MODEM状态信息---------------------------// Procedure tFrm_Call.ShowModemStatusInfo; var sInfo:string; begin sInfo:=''; if hCommFile=Invalid_Handle_Value then exit; if ModemStatus and MS_CTS_ON <>0 then sInfo:=sInfo+'CTS[清理待发送] '; if ModemStatus and MS_DSR_On <>0 then sInfo:=sInfo+'DSR[数据准备OK] '; if ModemStatus and MS_Ring_On<>0 then sInfo:=sInfo+'RING[响铃...] '; if ModemStatus and MS_RLSD_ON<>0 then sInfo:=sInfo+'RLSD[检测到接收信号]'; if sInfo<>'' then ShowInfo(sInfo); End; //----------------------------Close-------------------------------------------// procedure TFrm_Call.FormClose(Sender: TObject; var Action: TCloseAction); begin action:=CaFree; if PlaySignal then ClosePlay; if hCommFile<>Invalid_Handle_Value then Try CloseHandle(hCommFile); if WaveFormat<>Nil then FreeMem(WaveFormat,sizeof(WaveFormat)); Except End; if LineApp<>0 then Try LineShutDown(LineApp); Except End; end; //----------------------------------------------------------------------------// procedure TFrm_Call.FormCreate(Sender: TObject); var sFile:string; begin self.edt_ComPort.Text:='2'; edt_phone.Text:=''; edt_Time.Text:='22000'; ListBox1.Color:=self.Color; TrackBar1.Position:=3; edt_SoundTime.Text:='800'; edt_WaveFile.Text:=ExtractFilePath(Application.ExeName)+'GsSound.WAV'; Application.MessageBox('您使用的软件尚未注册,软件有30天试用期,请尽快联系软件供应商注册,谢谢!','软件注册',32); End; //--------------------执行AT指令函数，返回Boolean-----------------------------// Function tFrm_Call.DoAtCommand(const sATCommand:string='';hFileHandle:tHandle=Handle_Use_Default):Boolean; var fHandle:tHandle; fCommand:string; begin Result:=False; fCommand:=trim(uppercase(sAtCommand)); if (fCommand='') or (fHandle=Invalid_Handle_Value) then exit; if leftstr(fCommand,2)<>'AT' then fCommand:='AT'+fCommand; //头部AT if RightStr(fCommand,2)<>#13+#10 then fCommand:=fCommand+#13+#10; //尾部回车 if hFileHandle=Handle_Use_Default then fHandle:=hCommFile else fHandle:=hFileHandle; //写入代表串口的文件 Try Result:=WriteFile(fHandle,pChar(fCommand)^,length(fCommand),NumberWritten,Nil); Except End; //显示信息 if Result then ShowInfo('写入串口指令成功；'+'写入字节数：'+IntToStr(NumberWritten)) Else ShowInfo('写入串口指令失败！'); end; //-----------------------开始-------------------------------------------------// procedure TFrm_Call.cmd_StartClick(Sender: TObject); var CommPort,sPhone,sName:string; begin //变量、标志 DialRunType:=1; CommPort:='COM'+self.edt_ComPort.Text; hCommFile:=Invalid_Handle_Value; xWaveDevice:=0; xHandle:=self.Handle; xInstance:=Integer(self); SndPlayTime.wType:=Time_Bytes; //字节计 PlaySignal:=False; Call:=0; ErrorCode:=0; fWaveFile:=Trim(edt_WaveFile.Text); SndWaveFile:=fWaveFile; //-------------打开数据库----------------// if not AdoQuery_W.Active then //打开数据库 Try AdoQuery_W.Open; showInfo('打开数据库成功'); Except Application.MessageBox('打开数据库失败！','数据库',32); Exit; End; If AdoQuery_W.recordcount<=0 then begin ShowInfo('数据库没有数据，终止~！'); Exit; End; Timer_Run.Interval:=StrToIntDef(edt_Time.Text,15000); Timer_Play.Interval:=StrToIntDef(edt_SoundTime.Text,800); Timer_ShutDown.Enabled:=True; //--------判断拨号类别并执行-----------------------// if RadioButton_TAPI.Checked then Begin //-----TAPI拨号 if not APIDialTest then exit; //所有的初始化工作这里处理 if ReadInfoFromDataLoop(sPhone,sName) then APIStartCall(sPhone); Timer_Run.Enabled:=True; //打开循环过程 Timer_Play.Enabled:=True; //打开声音播放 End Else Begin //------AT拨号 If hCommFile=Invalid_Handle_Value then if not ATInitlizeModem() then exit; //初始化Modem Try DoAtCommand('ATL'+IntToStr(TrackBar1.Position-1)); ShowInfo('设置Modem音量'); Except End; Timer_Run.Enabled:=True; //调用主程序 Timer_Play.Enabled:=False; //关闭声音播放 End; ShowInfo('请等待,正在准备第一个拨号进程.'); end; //-----------------------停止-------------------------------------------------// procedure TFrm_Call.cmd_StopClick(Sender: TObject); begin Timer_Run.Enabled:=False; Timer_ShutDown.Enabled:=False; If RadioButton_TApi.Checked then Begin if PlaySignal then ClosePlay; APIStopCall; Timer_Play.Enabled:=False; end else Begin //---------AT----------// if hCommFile<>Invalid_Handle_Value then Try CloseHandle(hCommFile); Except ShowInfo('可忽略错误：停止关闭串口句柄失败。'); End; End; end; //--------------------------信息显示过程--------------------------------------// Procedure tFrm_Call.ShowInfo(const sMsg:string='';lShowTime:Boolean=True;lMessageBox:Boolean=False); var xMsg:string; begin if not lShowTime then xMsg:=sMsg else xMsg:=sMsg+' ['+DateTimeToStr(now)+']'; if frm_Call=Nil then exit; Frm_Call.ListBox1.Items.Add(xMsg); if lMessagebox then Messagebox(self.Handle,pchar(xMsg),pChar(Trim(application.Name)),32); end; //------------------------AT的初始化Modem-------------------------------------// Function tFrm_Call.ATInitlizeModem:Boolean; var CommPort:string; begin Result:=False; CommPort:='Com'+IntToStr( StrToIntDef(self.edt_ComPort.Text,1) ); ShowInfo('Modem线路初始化：使用串口'+CommPort); //将Com作为文件打开：名称、打开方式、共享方式、安全属性、创建属性、标志属性、取自句柄 hCommFile:=CreateFile(pChar(CommPort),Generic_Write,0,Nil,Open_Existing,File_Attribute_Normal,0); If hCommFile=Invalid_Handle_Value then ShowInfo('打开串口'+CommPort+'初始化失败！') else begin ShowInfo('打开串口'+CommPort+'成功！'); Result:=True; End; end; //---------------------AT循环拨号程序--------------------------// Function tFrm_Call.ATCall(const sPhone:string=''):Boolean; Begin Result:=False; if trim(sPhone)='' then exit; //-------显示Modem状态 if GetCommModemStatus(hCommFile,ModemStatus) then //获取Modem状态 ShowModemStatusInfo //显示MODEM状态 Else Begin ShowInfo('获取Modem状态失败！等待下次重试'); Exit; End; //----------执行AT命令断开线路----------------------------// Try DoAtCommand('ATH0'+#13+#10); ShowInfo('断开线路指令成功，准备重新拨号'); Sleep(strtointdef(edt_SoundTime.Text,800)); Except ShowInfo('断开线路指令失败，尝试继续拨号'); End; //-------------执行AT指令继续拨号------------------------// Try DoAtCommand('ATDT'+sPhone+#13+#10); ShowInfo('拨号中。。。。。。'); // Sleep(Timer_Run.Interval-strtointdef(edt_SoundTime.Text,800)-300); Result:=True; Except ShowInfo('拨号失败！'); Exit; End; End; //------------------------拨号主程序----------------------------------------// procedure TFrm_Call.Timer_RunTimer(Sender: TObject); var sPhone,sName:String; nValue:Cardinal; begin //---------循环读取数据库信息 if not ReadInfoFromDataLoop(sPhone,sName) then exit; //读取数据 Edt_Phone.Text:=sPhone; if sPhone='' then Begin ShowInfo('当前数据库电话信息是空的，忽略，继续下一个'); Exit; End; //----------拨号调度主程序--------------// if self.RadioButton_AT.Checked then Begin //-------AT拨号 if hCommFile=Invalid_Handle_Value then exit; ATCall(sPhone); End Else Begin //--------TAPI拨号 Try //APIGetCallStatus(nValue); if PlaySignal then ClosePlay; //停止声音播放 APIStopCall; //停止拨号,LineShutDown级 Call:=0; if not APIDialTest then exit; If not APIDialPrepare then exit; //准备......打开线路 If not APIDial(sPhone) then exit; //重新拨号 if not Timer_Play.enabled then Timer_Play.Enabled:=True; //打开声音播放 ShowInfo('TAPI拨号中......'); Finally End; End; End; //-------------声音播放重复调度程序--------------------// procedure TFrm_Call.Timer_PlayTimer(Sender: TObject); var nValue:dWord; begin if PlaySignal then exit; //如果正在播放，则退出 Try if not APIGetCallStatus(nValue) then exit; //获取状态 //if (nValue<>LineCallState_CONNECTED) or (nValue=LineCallState_DisConnected) then exit; xWaveDevice:=GetWaveDeviceID(); if xWaveDevice=0 then exit; //播放声音 if OpenWaveFile(fWaveFile)=0 then exit; PlayWaveFile(Handle); Except End; End; procedure TFrm_Call.N1Click(Sender: TObject); begin ListBox1.Items.Clear; end; procedure TFrm_Call.N2Click(Sender: TObject); begin if SaveDialog1.Execute then ListBox1.Items.SaveToFile(SaveDialog1.FileName); end; procedure TFrm_Call.cmd_GetWaveFileClick(Sender: TObject); begin if OpenDialog1.Execute then edt_WaveFile.Text:=OpenDialog1.FileName; end; procedure TFrm_Call.cmd_FirmClick(Sender: TObject); begin if trim(edt_Phone.Text)='' then Begin Application.MessageBox('没有电话号码!','电话号',32); exit; End; DialRunType:=2; fWaveFile:=Trim(edt_WaveFile.Text); SndWaveFile:=fWaveFile; //Apistartcall(edt_Phone.Text); Timer_Run.Interval:=StrToIntDef(self.edt_Time.Text,20000); Timer_Play.Interval:=StrToIntDef(self.edt_SoundTime.Text,800); Timer_Run.Enabled:=True; Timer_Play.Enabled:=True; Timer_ShutDown.Enabled:=True; APIStartCall(edt_Phone.Text); end; procedure TFrm_Call.Timer_ShutDownTimer(Sender: TObject); var sValue:string; Begin sValue:=LeftStr(timetostr(time),5); if Trim(edt_ShutDownTime.Text)>sValue then exit; self.cmd_Stop.Click; ExitWindowsEx(EWX_PowerOff,0); End; end.

继续阅读《用普通Modem制作拨号应答中心》的全文内容...