用普通Modem制作拨号应答,原来写在大富翁，汇总过来

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.