⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unitmain.pas

📁 自动语音应答系统
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit UnitMain;

interface

uses
  WinTypes,shellapi,
  WinProcs,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls,
  ExtCtrls,registry,
  Menus,AdTapi,
  AdTutil,
  AdPort, OoMisc,AdTSel_My, AdTStat, MMHook, MMDesign,
  MMObj, MMACMDlg, MMDSPObj, MMWave, MMCstDlg;

const
  RegPath='SOFTWARE\www\Telephone';
  CurrentState : Integer = 0;
  StateGreeting          = 0;
  StateRecording         = 1;  
  StateIdle              = 2;
  StateBeeping           = 3;
  StatePlayback          = 4;
  StateDial              = 5;
  StateDialing           = 6;
  StateAnswer            = 7;
type
  TFormMain = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    CallerID: TEdit;
    CallerIDName: TEdit;
    Button2: TButton;
    Button9: TButton;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    MaxLengthEdit: TEdit;
    Monitor: TCheckBox;
    ApdComPort1: TApdComPort;
    Button6: TButton;
    Label6: TLabel;
    Button41: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    Edit2: TEdit;
    Label7: TLabel;
    Button8: TButton;
    Label3: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    ApdTapiDevice1: TApdTapiDevice;
    Timer1: TTimer;
    Button1: TButton;
    Button10: TButton;
    ComboBox1: TComboBox;
    Button7: TButton;
    MMACM1: TMMACM;
    MMDesigner1: TMMDesigner;
    MMWaveFile1: TMMWaveFile;
    MMWaveOpenDialog1: TMMWaveOpenDialog;
    ApdTapiLog1: TApdTapiLog;
    Label14: TLabel;
    Button3: TButton;
    Button5: TButton;
    Button4: TButton;
    Label8: TLabel;
    ComboBox2: TComboBox;
    Button11: TButton;
    procedure CvtProgressCB(Sender: TObject; CurByte, NumBytes: Longint;
         Var Cancel: Boolean);
    procedure ConvertPCM;
    procedure ConvertACM;    
    procedure Button2Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure ApdTapiDevice1TapiConnect(Sender: TObject);
    procedure ApdTapiDevice1TapiWaveNotify(CP: TObject; Msg: TWaveMessage);
    procedure ApdTapiDevice1TapiCallerID(CP: TObject; ID, IDName: String);
    procedure MaxLengthEditExit(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure ApdTapiDevice1TapiFail(Sender: TObject);
    procedure Button41Click(Sender: TObject);
    procedure ApdTapiDevice1TapiDTMF(CP: TObject; Digit: Char;
      ErrorCode: Integer);
    procedure CheckBox2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure MonitorClick(Sender: TObject);
    procedure Label3Click(Sender: TObject);
    procedure Label10Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ApdTapiDevice1TapiStatus(CP: TObject; First, Last: Boolean;
      Device, Message, Param1, Param2, Param3: Cardinal);
   {注意:APRO4.x中最好把此两行改成以下
   procedure ApdTapiDevice1TapiStatus(CP: TObject; First,
       Last: Boolean; Device, Message, Param1, Param2, Param3: longint); }
    procedure Button1Click(Sender: TObject);
    procedure CallerIDChange(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure ApdTapiDevice1TapiWaveSilence(CP: TObject; var StopRecording,
      Hangup: Boolean);
    procedure ApdTapiDevice1TapiWaveRingback(CP: TObject;
      var RingbackTimes: Integer; var StopRecording, Hangup: Boolean);
    procedure ApdTapiDevice1TapiWaveBusy(CP: TObject; var StopRecording,
      Hangup: Boolean);
    procedure ComboBox1Exit(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure ComboBox2Exit(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    RecordNextFile:boolean;
    FileName : String;
    files:integer;
    caller:boolean;
    Timer1Busy:boolean; //Timer1是否重新进入
  public
    Reg:TRegistry;
    WaveFileDir : String;
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

uses UnitFmtDialog,UnitPlay, UnitCvtProgress, UnitPhoneBook,
  UnitPhoneKeyboard, UnitRingDetect, UnitAbout;

{$R *.DFM}
procedure wait(msec:dword);
var
   t:DWORD;
begin
   t:=gettickcount;
   while gettickcount-t<msec do application.ProcessMessages;
end;

procedure TFormMain.Button2Click(Sender: TObject);
begin 
  SelectDevice_My(ApdTapiDevice1,true,regpath);
  ApdTapiDevice1.EnableVoice:=True;
end;

procedure TFormMain.Button9Click(Sender: TObject);
begin
      if not ApdTapiDevice1.Cancelled then
      try
         if ApdTapiDevice1.WaveState = wsRecording then
            ApdTapiDevice1.StopWaveRecord;
         ApdTapiDevice1.OnTapiFail:=nil;
         ApdTapiDevice1.CancelCall;
      finally
         while ApdTapiDevice1.TapiState <> tsIdle do  Application.ProcessMessages;
         wait(1000); //等1秒
         ApdTapiDevice1.OnTapiFail:=ApdTapiDevice1TapiFail;
      end;
      Label4.Caption := '已经断开';
      Button6.Enabled:=true;
      Button8.Enabled:=true;
      Button7.Enabled:=CheckBox2.checked;
      timer1.enabled:=true;
end;

procedure TFormMain.ApdTapiDevice1TapiConnect(Sender: TObject);
var
  WaveFile:string;
begin
  if CurrentState = StateDial then
  begin
     Label4.Caption := '建立连接';
     CurrentState := StateDialing;
     WaveFile:=WaveFileDir+'静音.wav';
     try
        ApdTapiDevice1.PlayWaveFile(WaveFile);
     except
        MessageDlg('播放文件错误:'+WaveFile,mtInformation, [mbOk], 0);
     end;
  end
  else if CurrentState = StateAnswer then
  begin
     CurrentState := StateGreeting;
     Label4.Caption := '播放问候语';
     WaveFile:=combobox1.text;
     if not fileexists(WaveFile) then WaveFile:=WaveFileDir+'静音.wav';
     try
        ApdTapiDevice1.PlayWaveFile(WaveFile);
     except
        MessageDlg('播放文件错误:'+WaveFile,mtInformation, [mbOk], 0);
     end;
  end
  else
     caption:=inttostr(currentstate);
end;

procedure TFormMain.ApdTapiDevice1TapiWaveNotify(CP: TObject;
  Msg: TWaveMessage);
var
  datetime : TDateTime;
  year,month,day,hour,min,sec,msec : word;
  max : integer;
  sr : TSearchRec;
begin
  if (CurrentState = StateDialing)or(CurrentState = StateDial) then
  begin
    case Msg of
    waPlayClose :
       begin
          ApdTapiDevice1.MaxMessageLength :=60*60;
          try
             ApdTapiDevice1.StartWaveRecord;
             if RecordNextFile then //是否是第二个文件
             begin
                Label4.caption:='正在录音';
                RecordNextFile:=false;
             end;
          except
          end;
       end;
    waDataReady:
       begin
          datetime:=now;
          decodedate(datetime,year,month,day);
          decodetime(datetime,hour,min,sec,msec);
          if callerid.text=',' then
             FileName := WaveFileDir+Format('%.2d-%.2d-%.2d %.2d:%.2d:%.2d',[year,month,day,hour,min,sec])+'录音.wav'
          else FileName := WaveFileDir+Format('%.2d-%.2d-%.2d %.2d:%.2d:%.2d',[year,month,day,hour,min,sec])+'拨打'+callerid.text+'.wav';
          ApdTapiDevice1.SaveWaveFile(FileName, True);
       end;
    waRecordClose :
       begin
          if RecordNextFile then //是否播放第二个文件
          begin
             DeleteFile(FileName);
             try
                ApdTapiDevice1.PlayWaveFile(combobox2.text); //播放第二个文件
                Label4.caption:='播放问候语';
             except
                MessageDlg('播放文件错误:'+combobox2.text,mtInformation, [mbOk], 0);
             end;
          end
          else begin //没有第二个播放文件
             Button9Click(Self);
             if findfirst(FileName,faAnyfile and not faDirectory,sr)=0 then
             begin
                if (sr.Size<=110*1024)or
                   (pos('回铃音.....',Label14.caption)=1) then
                   deletefile(FileName)
                else begin
                   inc(files);
                   Button10.caption:=inttostr(files)+'个录音';
                end;
             end;
          end;
       end;
    end;
  end
  else begin
    case Msg of
    waPlayClose :
      case CurrentState of
      StateGreeting :
          begin
            CurrentState := StateBeeping;
            try
               ApdTapiDevice1.PlayWaveFile(WaveFileDir+'beep.wav');
            except
                MessageDlg('播放文件错误:'+'beep.wav',mtInformation, [mbOk], 0);
            end;
          end;
      StateBeeping :
          begin
            CurrentState := StateRecording;
            if CheckBox1.Checked then max:=strtointdef(MaxLengthEdit.Text,60*60)
            else max:=60*60;
            ApdTapiDevice1.MaxMessageLength :=max;
            try
               ApdTapiDevice1.StartWaveRecord;
               Label4.caption:='正在录音';
            except
            end;
          end;
      end;
    waDataReady :
      begin
        datetime:=now;
        decodedate(datetime,year,month,day);
        decodetime(datetime,hour,min,sec,msec);
        if not caller then callerid.text:='';
        FileName := WaveFileDir+Format('%.2d-%.2d-%.2d %.2d:%.2d:%.2d',[year,month,day,hour,min,sec])
           +'接听'+callerid.text+'.wav';
        ApdTapiDevice1.SaveWaveFile(FileName, True); 
      end;
    waRecordClose : 
       begin
          Button9Click(Self);
          inc(files); 
          Button10.caption:=inttostr(files)+'个录音';
       end;
    end;
  end;
end;

procedure TFormMain.ApdTapiDevice1TapiCallerID(CP: TObject; ID,
  IDName: String);
begin
  CallerId.Text := ID;
  CallerIdName.Text := IDName;
  Caller:=true;
end;

procedure TFormMain.MaxLengthEditExit(Sender: TObject);
begin
   reg.writestring('AnswerRecordTime',MaxLengthEdit.text);
end;

procedure TFormMain.Button6Click(Sender: TObject);
begin
   Label14.caption:='';
   if not ApdTapiDevice1.EnableVoice then
   begin
      MessageDlg('没有选择正确的猫.', mtInformation, [mbOk], 0);
      exit;
   end;
   callerid.text:=trim(callerid.text);
   if callerid.text<>'' then
   begin
      try
         ApdTapiDevice1.OnTapiFail:=nil;
         ApdTapiDevice1.CancelCall;
      finally
         while ApdTapiDevice1.TapiState <> tsIdle do  Application.ProcessMessages;
         wait(1000); //等1秒
         ApdTapiDevice1.OnTapiFail:=ApdTapiDevice1TapiFail;
      end;
      Button6.Enabled:=false;
      Button8.Enabled:=false;
      Button7.Enabled:=false;
      RecordNextFile:=false; //是否播放第二个文件
      Label4.Caption := '正在拨号';
      CurrentState := StateDial;
      ApdTapiDevice1.Dial(callerid.text);
   end
   else MessageDlg('请输入电话号码.', mtInformation, [mbOk], 0);
end;

procedure TFormMain.CheckBox1Click(Sender: TObject);
begin
   MaxLengthEdit.Enabled:=CheckBox1.Checked;
   if CheckBox1.Checked then reg.writeinteger('AnswerRecord',1)
   else reg.writeinteger('AnswerRecord',0);
end;

procedure TFormMain.ApdTapiDevice1TapiFail(Sender: TObject);
begin  
  CurrentState := StateIdle;
  Label4.Caption := '已经断开';
  Button6.Enabled:=true;
  Button8.Enabled:=true;
  Button7.Enabled:=CheckBox2.checked;
  if CurrentState = StateAnswer then CheckBox2.checked:=false
  else timer1.enabled:=true;  
end;

procedure TFormMain.ConvertPCM;
begin 
      FmtDialog.Wave := MMWaveFile1.Wave;
      if (FmtDialog.ShowModal = mrOk) then
      begin
         try
            try
               with FormCvtProgress do
               begin
                  Gauge1.Progress := 0;
                  BringToFront;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -