main.pas

该控件是一个不错的来电显示控件

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,tapi, StdCtrls, Buttons, ComCtrls;

const
  HiVer = $00020000;  // Highest API version wanted (2.0)
  LoVer = $00010004;  // Lowest API version accepted (1.4)
type
  TForm1 = class(TForm)
    Label1: TLabel;
    BitBtn1: TBitBtn;
    Edit1: TEdit;
    StatusBar1: TStatusBar;
    Edit2: TEdit;
    Label2: TLabel;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    FLine:HLine;
    NDevs:LongInt;
    FLineApp:HLineApp;
    
  public
    { Public declarations }
    FCall:HCall;
  end;
  function LineCallStateToStr (CallState : DWORD) : string;
  function LineCallStateInfoToStr (CallState, Info : DWORD) : string;

  procedure LineCallbackProc (hDevice,
                            dwMessage,
                            dwInstance,
                            dwParam1,
                            dwParam2,
                            dwParam3 : DWORD); stdcall;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function LineCallStateToStr (CallState : DWORD) : string;
begin
  case CallState of
    LINECALLSTATE_IDLE :
      Result:='IDLE';
    LINECALLSTATE_OFFERING :
      Result:='OFFERING';
    LINECALLSTATE_ACCEPTED :
      Result:='ACCEPTED';
    LINECALLSTATE_DIALTONE :
      Result:='DIALTONE';
    LINECALLSTATE_DIALING :
      Result:='DIALING';
    LINECALLSTATE_RINGBACK :
      Result:='RINGBACK';
    LINECALLSTATE_BUSY :
      Result:='BUSY';
    LINECALLSTATE_SPECIALINFO :
      Result:='SPECIALINFO';
    LINECALLSTATE_CONNECTED :
      Result:='CONNECTED';
    LINECALLSTATE_PROCEEDING :
      Result:='PROCEEDING';
    LINECALLSTATE_ONHOLD :
      Result:='ONHOLD';
    LINECALLSTATE_CONFERENCED :
      Result:='CONFERENCED';
    LINECALLSTATE_ONHOLDPENDCONF :
      Result:='ONHOLDPENDCONF';
    LINECALLSTATE_ONHOLDPENDTRANSFER :
      Result:='ONHOLDPENDTRANSFER';
    LINECALLSTATE_DISCONNECTED :
      Result:='DISCONNECTED';
    LINECALLSTATE_UNKNOWN :
      Result:='UNKNOWN';
  else
    Result:='Unknown (' + IntTostr(CallState) + ')';
  end;
end;

function LineCallStateInfoToStr (CallState, Info : DWORD) : string;
begin
  Result:='';
  if Info = 0 Then
     Result:='命令执行完毕';
  case CallState of
    LINECALLSTATE_DIALTONE :
      case Info of
        LINEDIALTONEMODE_NORMAL :
          Result:='拨号音正常';
        LINEDIALTONEMODE_SPECIAL :
          Result:='SPECIAL';
        LINEDIALTONEMODE_INTERNAL :
          Result:='INTERNAL';
        LINEDIALTONEMODE_EXTERNAL :
          Result:='EXTERNAL';
        LINEDIALTONEMODE_UNKNOWN :
          Result:='UNKNOWN';
        LINEDIALTONEMODE_UNAVAIL :
          Result:='UNAVAIL';
      end;
    LINECALLSTATE_BUSY :
      case Info of
        LINEBUSYMODE_sTATION :
          Result:='STATION';
        LINEBUSYMODE_TRUNK :
          Result:='TRUNK';
        LINEBUSYMODE_UNKNOWN :
          Result:='UNKNOWN';
        LINEBUSYMODE_UNAVAIL :
          Result:='UNAVAIL';
      end;
    LINECALLSTATE_DISCONNECTED :
      case Info of
        LINEDISCONNECTMODE_NORMAL :
          Result:='NORMAL';
        LINEDISCONNECTMODE_UNKNOWN :
          Result:='UNKNOWN';
        LINEDISCONNECTMODE_REJECT :
          Result:='REJECT';
        LINEDISCONNECTMODE_PICKUP :
          Result:='PICKUP';
        LINEDISCONNECTMODE_FORWARDED :
          Result:='FORWARDED';
        LINEDISCONNECTMODE_BUSY :
          Result:='BUSY';
        LINEDISCONNECTMODE_NOANSWER :
          Result:='NOANSWER';
        LINEDISCONNECTMODE_BADADDRESS :
          Result:='BADADDRESS';
        LINEDISCONNECTMODE_UNREACHABLE :
          Result:='UNREACHABLE';
        LINEDISCONNECTMODE_CONGESTION :
          Result:='CONGESTION';
        LINEDISCONNECTMODE_INCOMPATIBLE :
          Result:='INCOMPATIBLE';
        LINEDISCONNECTMODE_UNAVAIL :
          Result:='UNAVAIL';
        LINEDISCONNECTMODE_NODIALTONE:      // TAPI v1.4
          Result:='NODIALTONE';
      end;
  end;
  if Result = '' then
    Result:='Undefined (' + IntToStr(Info) + ')';
end;

procedure LineCallbackProc (hDevice,
                            dwMessage,
                            dwInstance,
                            dwParam1,
                            dwParam2,
                            dwParam3 : DWORD); stdcall; far;
var
  S : string;
  done:boolean;
  callinfosize:dword;
  lpcallinfo:lplinecallinfo;
  lrtn:dword;
  pinfo:pchar;
begin
  case dwMessage of
       LINE_CLOSE:
           Begin
            S := '线路异常关闭!';
           End;
       LINE_CALLSTATE:
           Begin
            S := LineCallStateInfoToStr (dwParam1, dwParam2);
            case dwParam1 of
                LINECALLSTATE_CONNECTED: // CONNECTED!!!
                  form1.StatusBar1.Panels[0].Text:='呼叫连接建立成功';
                LINECALLSTATE_OFFERING://在这里可以建立多线程呼叫应答
                  begin
                    form1.FCall:=HCall(hDevice);
                    try
                      TapiCheck(lineAnswer(form1.FCall, nil, 0));
                    except
                      form1.StatusBar1.Panels[0].Text:='应答呼叫失败';
                      exit;
                    end;
                    try
                      callinfosize:=sizeof(lplinecallinfo);
                      getmem(lpcallinfo,callinfosize);
                      lpcallinfo.dwTotalSize:=callinfosize;
                      done:=false;
                      while not done do
                        begin
                          lrtn:=linegetcallinfo(form1.FCall,lpcallinfo);
                          if (lrtn<>0) and (lrtn<>LINEERR_STRUCTURETOOSMALL) then
                            begin
                              form1.StatusBar1.Panels[0].Text:='发生错误';
                              freemem(lpcallinfo);
                              exit;
                            end;
                          if (lrtn=0) and (lpcallinfo.dwNeededSize<=lpcallinfo.dwTotalSize) then
                            done:=true;
                          if (not done) and (lrtn=LINEERR_STRUCTURETOOSMALL) then
                            begin
                              callinfosize:=lpcallinfo.dwNeededSize;
                              freemem(lpcallinfo);
                              getmem(lpcallinfo,callinfosize);
                              lpcallinfo.dwTotalSize:=callinfosize;
                            end;
                        end;
                        if done then
                          begin
                            case lpcallinfo.dwCallerIDFlags of
                              LINECALLPARTYID_BLOCKED:
                                form1.StatusBar1.Panels[0].Text:='Call ID 功能被阻塞';
                              LINECALLPARTYID_OUTOFAREA:
                                form1.StatusBar1.Panels[0].Text:='网络不支持Call ID 功能';
                              LINECALLPARTYID_NAME:
                                begin
                                  getmem(pinfo,lpcallinfo.dwCallerIDNameSize);
                                  strmove(pinfo,pchar(long(lpcallinfo)+lpcallinfo.dwCallerIDNameOffset),lpcallinfo.dwCallerIDNameSize);
                                  form1.Edit1.Text:=pinfo;
                                  freemem(pinfo);
                                end;
                              LINECALLPARTYID_ADDRESS or LINECALLPARTYID_PARTIAL:
                                begin
                                  getmem(pinfo,lpcallinfo.dwCallerIDSize);
                                  strmove(pinfo,pchar(long(lpcallinfo)+lpcallinfo.dwCallerIDOffset),lpcallinfo.dwCallerIDSize);
                                  form1.Edit2.Text:=pinfo;
                                  freemem(pinfo);
                                end;
                              LINECALLPARTYID_UNKNOWN:
                                form1.StatusBar1.Panels[0].Text:='未知Call ID';
                              LINECALLPARTYID_UNAVAIL:
                                form1.StatusBar1.Panels[0].Text:='Call ID 不可用';
                              else
                                form1.Edit2.Text:=inttostr(lpcallinfo.dwCallID);
                            end;
                          end;
                    except
                      form1.StatusBar1.Panels[0].Text:='获取对方呼叫信息失败';
                      freemem(lpcallinfo);
                    end;
                  end;
                LINECALLSTATE_IDLE:
                  Begin
                    try
                     if form1.FCall.unused <> 0 Then
                      TapiCheck(lineDeallocateCall (form1.FCall));
                    except
                     form1.StatusBar1.Panels[0].Text:='处理呼叫空间失败';
                     exit;
                    end;
                    form1.FCall.unused := 0;
                  End;
                LINECALLSTATE_DISCONNECTED:
                  form1.StatusBar1.Panels[0].Text:='建立连接失败';
                LINECALLSTATE_BUSY:
                  form1.StatusBar1.Panels[0].Text:='占线或其他原因致使呼叫处于忙状态'
                else
                  S := LineCallStateToStr (dwParam1);
                end;
              end;
       LINE_REPLY :
          form1.StatusBar1.Panels[0].Text:='等待应答该请求'
  end;
  
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  if fline.unused <>0 then
    lineclose(fline);
  if flineapp.unused <>0 then
    lineshutdown(flineapp);
  application.Terminate;
end;

procedure TForm1.FormActivate(Sender: TObject);
var
  pVersion:longint;
  extID:TLineExtensionID;
begin
  if lineinitialize(@flineapp,getmodulehandle(nil),LineCallbackProc,nil,@NDevs)<0 then
    flineapp.unused:=0
  else if ndevs=0 then
    begin
      lineshutdown(flineapp);
      flineapp.unused:=0;
    end
  else if linenegotiateapiversion(flineapp,0,lover,hiver,@pversion,@extid)<0 then
    begin
      lineshutdown(flineapp);
      flineapp.unused:=0;
    end
  else if lineopen(flineapp,0,@fline,pversion,0,0,LINECALLPRIVILEGE_MONITOR or LINECALLPRIVILEGE_OWNER ,
    LINEMEDIAMODE_DATAMODEM,nil)<0 then
    begin
      lineshutdown(flineapp);
      flineapp.unused:=0;
      fline.unused:=0;
    end;
  if flineapp.unused=0 then
    statusbar1.Panels[0].Text:='打开线路失败!'
  else
    statusbar1.Panels[0].Text:='线路打开成功!';
  self.OnActivate:=nil;
end;

end.