{
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;

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.