DELPHI MODEM拨号放音

来源:互联网 发布:三维模型设计软件 mac 编辑:程序博客网 时间:2024/06/06 13:57

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.

 

原创粉丝点击