怎么用Delphi实现来电显示？

现有一个内置Moden,Dephi7.0上已经装了SPComm控件。电话已经到电信局申请了来电显示。怎么用SPComm得到来电号码呢？我运行时，打入电话显示的结果是:Ring  8.怎么才能得到来电号码呢？

19 个解决方案

#1

查询Modem的AT指令，具体的我忘了，晚上回去再来看看，现在up先！

#2

參考<<Delphi串口及語音傳真高級指南>>

#3

{
h0  挂断
h1  拿起
x4  检测拨号音
x0  不

S6 拨号前等待的时间
S0 自动应答

+FCLASS=8  进入语音模式
+FCLASS?
+FCLASS=?
+VIP     初始化语音
+VCID=n  来电者标识
+VCID?
+VCID=?
}

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, MSCommLib_TLB, StdCtrls, ExtCtrls,registry;

type
   DCB = record
        DCBlength :longint;
        BaudRate :longint;
        fBitFields :longint; //'See Comments in Win32API.Txt
        wReserved : smallint;
        XonLim : smallint;
        XoffLim : smallint;
        ByteSize : byte;
        PARITY : byte;
        StopBits : byte;
        XonChar : byte;
        XoffChar : byte;
        ErrorChar : byte;
        EofChar : byte;
        EvtChar : byte;
        wReserved1 : smallint; //'Reserved; Do Not Use
  End;
  TForm1 = class(TForm)
    MSComm1: TMSComm;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button4: TButton;
    Panel1: TPanel;
    Edit1: TEdit;
    Button3: TButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MSComm1Comm(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if mscomm1.PortOpen=true then mscomm1.PortOpen:=false;
end;

procedure TForm1.MSComm1Comm(Sender: TObject);
var
   s:string;
begin
// BUSY
// NO DIALTONE
// NO CARRIER     没有载波信号
   case mscomm1.CommEvent of
   comEvReceive:
      begin
      s:=MSComm1.Input;
      listbox1.items.add(s);
      end;
   end;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
   if key<>chr(13) then exit;
   mscomm1.Output:=edit1.text+chr(13);
   While mscomm1.OutBufferCount > 0 do application.ProcessMessages;
end;

procedure TForm1.FormShow(Sender: TObject);
var
   reg:tregistry;
   i:integer;
begin
   combobox1.clear;
   reg:=tregistry.create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;
   reg.openkey('System\CurrentControlSet\Services\Class\Modem\',true);
   reg.GetKeyNames(combobox2.items);
   reg.closekey;
   for i:=0 to combobox2.items.count-1 do
   begin
      reg.openkey('System\CurrentControlSet\Services\Class\Modem\'+combobox2.items[i],true);
      if reg.ValueExists('model') then combobox1.items.add(reg.ReadString('model'))
      else combobox1.items.add('#'+inttostr(i));
      reg.closekey;
   end;
   reg.free;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var
   reg:tregistry;
   i,j,k:integer;
   s:string;
   names:TStringlist;
   dcb1:DCB;
   t:longword;
   b:boolean;
begin
   if mscomm1.PortOpen=true then mscomm1.PortOpen:=false;
   i:=combobox1.itemindex;
   if i=-1 then exit;
   reg:=tregistry.create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;
   reg.openkey('System\CurrentControlSet\Services\Class\Modem\'+combobox2.items[i],true);
   if reg.valueexists('MatchingDeviceId') then s:=reg.Readstring('MatchingDeviceId')
   else s:='';  //com2 com4
   if (s='') then
   begin
      if (reg.valueexists('AttachedTo')) then s:=reg.Readstring('AttachedTo')
      else s:='';
   end
   else begin
      reg.closekey;
      if reg.OpenKey('Enum\'+s,false) then
      begin
         names:=Tstringlist.create;
         reg.GetKeyNames(names);
         reg.closekey;
         reg.OpenKey('Enum\'+s+'\'+names.strings[0],true);
         if reg.ValueExists('PORTNAME') then s:=reg.readstring('PORTNAME')
         else s:='';
         names.free;
      end
      else begin
         reg.free;
         exit;
      end;
   end;
   if copy(uppercase(s),1,3)<>'COM' then
   begin
      reg.closekey;
      reg.free;
      exit;
   end;
   delete(s,1,3);
   mscomm1.CommPort:=strtoint(s);
   reg.closekey;

   fillchar(dcb1,sizeof(dcb),0);
   reg.OpenKey('System\CurrentControlSet\Services\Class\Modem\'+combobox2.items[i],true);
   if reg.ValueExists('DCB') then reg.ReadBinaryData('DCB',dcb1,sizeof(dcb));
   s:=inttostr(dcb1.BaudRate);
   case dcb1.PARITY of
   0: s:=s+',E';
   1: s:=s+',M';
   2: s:=s+',N';
   3: s:=s+',O';
   4: s:=s+',S';
   end;
   mscomm1.Settings:=s+','+inttostr(dcb1.ByteSize)+','+inttostr(dcb1.StopBits div 2 +1);
   reg.closekey;

   try
      mscomm1.PortOpen:=true;
   except
      showmessage('猫正忙！');
      reg.free;
      close;
   end;

   //init
   b:=reg.OpenKey('System\CurrentControlSet\Services\Class\Modem\'+combobox2.items[i]+'\Init',false);
   if not b then b:=reg.OpenKey('System\CurrentControlSet\Services\Class\Modem\'+combobox2.items[i]+'\Settings\Init',false);
   if b then
   begin
      for k:=1 to 10 do
         if reg.ValueExists(inttostr(k)) then
         begin
            s:=reg.ReadString(inttostr(k));
            j:=pos('<CR>',uppercase(s));
            if j<>0 then s:=copy(s,1,j-1);
            j:=pos(chr(13),uppercase(s));
            if j<>0 then s:=copy(s,1,j-1);
            mscomm1.Output:=s+chr(13);
            while mscomm1.OutBufferCount>0 do application.processmessages;
            t:=gettickcount;
            while gettickcount-t<500 do application.processmessages;
         end;
      reg.closekey;
   end;

   mscomm1.Output:='ats0=0'+chr(13); //不接听电话
   while mscomm1.OutBufferCount>0 do application.processmessages;
   t:=gettickcount;
   while gettickcount-t<500 do application.processmessages;

   if reg.OpenKey('System\CurrentControlSet\Services\Class\Modem\'+combobox2.items[i]+'\EnableCallerID',false) then
   begin
      for k:=1 to 10 do
         if reg.ValueExists(inttostr(k)) then
         begin
            s:=reg.ReadString(inttostr(k));
            j:=pos('<CR>',uppercase(s));
            if j<>0 then s:=copy(s,1,j-1);
            j:=pos(chr(13),uppercase(s));
            if j<>0 then s:=copy(s,1,j-1);
            mscomm1.Output:=s+chr(13);
            while mscomm1.OutBufferCount>0 do application.processmessages;
            t:=gettickcount;
            while gettickcount-t<500 do application.processmessages;
            caption:='来电显示设置OK';
         end;
      reg.closekey;
   end;

   reg.free;
end;

#4

procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
   listbox1.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   t,j,r:longword;
   reg:Tregistry;
   s:string;
begin
   reg:=tregistry.create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;  //查找注册表中的"StopPlay"
   if reg.OpenKey('System\CurrentControlSet\Services\Class\Modem\'+combobox2.items[combobox1.itemindex]+'\StopPlay',false) and
      reg.ValueExists('1') then
   begin
      s:=reg.ReadString('1');
      j:=pos('<CR>',uppercase(s));
      if j<>0 then s:=copy(s,1,j-1);
      j:=pos(chr(13),uppercase(s));
      if j<>0 then s:=copy(s,1,j-1);
      //把形如<h10><h03>at<cr>的形式中的<h10>、<h03>转为十六进制1个字节
      j:=pos('<H',uppercase(s));      
      while j<>0 do
      begin
         if s[j+3]='>' then  //如果像<h3>形式，数字只有1位
         begin
            r:=strtoint('$'+s[j+2]); //ASCII转为十六进制
            s[j]:=chr(r);    //填入“<”的位置
            delete(s,j+1,3); //把“<”之后的都删除
         end
         else begin //如果像<h13>形式，数字有2位
            r:=strtoint('$'+s[j+2]+s[j+3]);
            s[j]:=chr(r);
            delete(s,j+1,4);
         end;
         j:=pos('<H',uppercase(s)); //继续下一个
      end;
      mscomm1.Output:=s+chr(13);  //关闭语音
      While mscomm1.OutBufferCount > 0 do application.ProcessMessages;
      t:=gettickcount;
      while gettickcount-t<500 do application.processmessages;
   end;
   reg.closekey;
   reg.free;

{   mscomm1.Output:='at+FCLASS=8'+chr(13);
   While mscomm1.OutBufferCount > 0 do application.ProcessMessages;
   t:=gettickcount;
   while gettickcount-t<500 do application.processmessages; }
end;

procedure TForm1.Button2Click(Sender: TObject);
var
   t,j:longword;
   reg:TRegistry;
   s:string;
begin
   mscomm1.Output:='AT+FCLASS=8'+chr(13);
   While mscomm1.OutBufferCount > 0 do application.ProcessMessages;
   t:=gettickcount;
   while gettickcount-t<500 do application.processmessages;

   mscomm1.Output:='ATDT112'+chr(13); //拨打免费电话112
   While mscomm1.OutBufferCount > 0 do application.ProcessMessages;
   t:=gettickcount;
   while gettickcount-t<4000 do application.processmessages;

   mscomm1.Output:='AT+VIP'+chr(13);
   While mscomm1.OutBufferCount > 0 do application.ProcessMessages;
   t:=gettickcount;
   while gettickcount-t<500 do application.processmessages;

   mscomm1.Output:='at+vsm=2,8000,0,0'+chr(13);
   While mscomm1.OutBufferCount > 0 do application.ProcessMessages;
   t:=gettickcount;
   while gettickcount-t<500 do application.processmessages;
   mscomm1.Output:='at+vls=6'+chr(13);
   While mscomm1.OutBufferCount > 0 do application.ProcessMessages;
   t:=gettickcount;
   while gettickcount-t<500 do application.processmessages;
   mscomm1.Output:='at+vgr=131'+chr(13);
   While mscomm1.OutBufferCount > 0 do application.ProcessMessages;
   t:=gettickcount;
   while gettickcount-t<500 do application.processmessages;

   reg:=tregistry.create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;  //查找注册表中的“StartPlay”
   if reg.OpenKey('System\CurrentControlSet\Services\Class\Modem\'+combobox2.items[combobox1.itemindex]+'\StartPlay',false) and
      reg.ValueExists('1') then
   begin
      s:=reg.ReadString('1');
      j:=pos('<CR>',uppercase(s));
      if j<>0 then s:=copy(s,1,j-1);
      j:=pos(chr(13),uppercase(s));
      if j<>0 then s:=copy(s,1,j-1);
      mscomm1.Output:=s+chr(13);  //开始播放语音数据
      While mscomm1.OutBufferCount > 0 do application.ProcessMessages;
      t:=gettickcount;
      while gettickcount-t<500 do application.processmessages;
   end;
   //之后写入串口的数据都被当作语音数据
   reg.closekey;
   reg.free;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   mscomm1.Output:=edit1.text+chr(13);
   While mscomm1.OutBufferCount > 0 do application.ProcessMessages;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
   close;
end;

end.

#5

注：你要确保你的内置modem具有来电显示功能！如果程序不能正常工作，可能所选择的Modem使用了"标准调制调解器"驱动程序或基它不兼容的驱动程序，建议使用Modem原配的驱动序。还有一点：好像在98后面的版本，如2000,xp里面Modem的语音功能都支持不了（即使安装了Modem自带驱动程序），我曾经试过几种Modem，都未成功，你可以再试一试！！

#6

extcsdn(Studing VB now):
请问怎么知道我的内置modem具有来电显示功能呢？

#7

hexenzhou(甲骨文)：
AT指令我有，我是想要一个具体的接收来电号码的例子。
extcsdn(Studing VB now) 的代码太多了，太复杂。

#8

没用过，顶吧

#9

to: wfn(zll) 

请问怎么知道我的内置modem具有来电显示功能呢？
上网查询，看你那个型号的modem是否支持来电显示！！

hexenzhou(甲骨文)：
AT指令我有，我是想要一个具体的接收来电号码的例子。
extcsdn(Studing VB now) 的代码太多了，太复杂。

这个代码我已经上传到www.2ccc.com  你可以去下载下来直接用就可以了！！

#10

顺便说一下，这个也叫做“太多了，太复杂”？？？郁闷！！

#11

嗨，看来大侠门已经回答了，不需要我了。

#12

先仔细看看extcsdn(Studing VB now)的代码，多谢各位大侠，特别是 extcsdn(Studing VB now) 。

#13

问题还没解决，可能是我的Moden不支持来电显示（怎么知道是否支持来电显示呢？）。看了extcsdn(Studing VB now)的代码，是用MScomm控件做的，我要的是SPComm控件的例子。而且我用的是Win2000,注册表中找不到System\CurrentControlSet\Services\Class\Modem，找到System\CurrentControlSet\Services\Modem，里面也没有这些参数。还有AT指令是不是Comm1.WriteCommData（'AT+VCI=1',8);这样发到串口的？闷郁中...

#14

好象盒子有代码啊,去看看,没有我个你一个,留个email

#15

TAPI好像有这样的API吧

也赏点分吧

#16

我的Email是:[e-mail]
谢谢！

#17

邮件发送给: [e-mail]  
 抄送给: 无  
 密送给: 无 

#18

好像在98后面的版本，如2000,xp里面Modem的语音功能都支持不了（即使安装了Modem自带驱动程序），我曾经试过几种Modem，都未成功

#19

remark

#20

• 用MODEM实现来电显示的方法 (转网上)
• Android来电，显示悬浮窗