callform.pas

TAPI 编程事例

unit Callform;
{
	*** TAPI Monitor ***
        by Davide Moretti <[e-mail]>

	This is a TAPI Test
	It uses TAPI interface to place outgoing calls.
	You can also monitor these calls with the Monitor...
}

interface

uses
	SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
	Forms, Dialogs, StdCtrls, Tapi, ExtCtrls;

type
	TfrmTAPICall = class(TForm)
    Label1: TLabel;
		Edit1: TEdit;
		btnCall: TButton;
    Memo1: TMemo;
		btnDropCall: TButton;
    grpMode: TRadioGroup;
		procedure FormCreate(Sender: TObject);
		procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnCallClick(Sender: TObject);
    procedure btnDropCallClick(Sender: TObject);
    procedure grpModeClick(Sender: TObject);
	private
		{ Private declarations }
		lineApp: THLineApp;// TAPI应用句柄
		line: THLine; //线路句柄
		call: THCall; // 呼叫句柄
		CallParams: TlineCallParams;//呼叫参数
	public
		{ Public declarations }
	end;

var
	frmTAPICall: TfrmTAPICall;

implementation

{$R *.DFM}

uses Main;

var
	buf:array[0..1023] of char;
	callinfo: TLineCallInfo absolute buf;
  {
    这两个变量指向同一个地址
    而lineGetCallInfo函数需要一个TLineCallInfo类型的指针
	}

{
  TAPI回调函数，处理TAPI各类的消息。
  主要用于实现拨号  
}
procedure lineCallback(hDevice, dwMsg, dwCallbackInstance,
		dwParam1, dwParam2, dwParam3: LongInt);	stdcall;
	var
		s: string;
		hCall: THCall;
    
	begin

  { LineMakeCall调用的结果 }
	if dwMsg = LINE_REPLY then
		if dwParam2 < 0 then
			frmTAPICall.Memo1.Lines.Add('Reply error')
		else
			frmTAPICall.Memo1.Lines.Add('LINE_REPLY ok')
      
  { 线路状态发生了改变 }
	else if dwMsg = LINE_CALLSTATE then
		begin
		hCall := THCall(hDevice);
		case dwParam1 of
    
      { 呼叫无效 }
			LINECALLSTATE_IDLE:
				if hcall <> 0 then
					begin
					lineDeallocateCall(hCall);	// 释放呼叫句柄 
					frmTAPICall.Memo1.Lines.Add('Idle - call deallocated');
					frmTAPICall.btnCall.Enabled := True;
					frmTAPICall.btnDropCall.Enabled := False;
					end;

      { 呼叫建立成功 }
			LINECALLSTATE_CONNECTED:
				if hCall <> 0 then
					begin
					s := 'Connected: ';
					callinfo.dwTotalSize := 1024;
					if lineGetCallInfo(hCall, callinfo) = 0 then
						if callinfo.dwAppNameSize > 0 then
							s := s + (buf + callinfo.dwAppNameOffset); 
					frmTAPICall.Memo1.Lines.Add(s);
					end;

      { 呼叫处理过程中  }
			LINECALLSTATE_PROCEEDING:
				frmTAPICall.Memo1.Lines.Add('Proceeding');
      { 呼叫拨号过程中  }             
			LINECALLSTATE_DIALING:
				frmTAPICall.Memo1.Lines.Add('Dialing');
      { 呼叫远端挂起  }             
			LINECALLSTATE_DISCONNECTED:	
				begin
				s := 'Disconnected: ';
				if dwParam2 = LINEDISCONNECTMODE_NORMAL then
					s := s + 'normal'
				else if dwParam2 = LINEDISCONNECTMODE_BUSY then
					s := s + 'busy';
				frmTAPICall.Memo1.Lines.Add(s);
				frmTAPICall.btnDropCall.Click;
				end;        
      { 接收到忙音 }
			LINECALLSTATE_BUSY:
				frmTAPICall.Memo1.Lines.Add('Busy');
			end;
		end;
	end;

//窗体建立时，初始化TAPI  
procedure TfrmTAPICall.FormCreate(Sender: TObject);
	var
		nDevs, tapiVersion: Longint;
		extid: TLineExtensionID;
	begin

	{ 清空并设置CallParams结构 }
	FillChar(CallParams, sizeof(CallParams), 0);
  with CallParams do
		begin
		dwTotalSize := sizeof(CallParams);
		dwBearerMode := LINEBEARERMODE_VOICE;
		dwMediaMode := LINEMEDIAMODE_INTERACTIVEVOICE;
		end;

	{ 初始化TAPI }    
	if lineInitialize(lineApp, HInstance,
			lineCallback, nil, nDevs) < 0 then		{ < 0 是错误的 }
		lineApp := 0

  { 如果没有设备则释放线路设备 }
	else if nDevs = 0 then
		begin
		lineShutDown(lineApp);
		lineApp := 0;
		end

  {检查TAPI的版本号}    
	else if lineNegotiateAPIVersion(lineApp, 0, $00010000, $10000000,
			tapiVersion, extid) < 0 then
		begin
		lineShutDown(lineApp);
		lineApp := 0;
		end

	{ 打开线路，得到由Windows返回的线路设备句柄，通常是Modem }
  { 指定参数dwPrivileges为LINECALLPRIVILEGE_NONE，可被监控 }
	else if lineOpen(lineApp, LINEMAPPER, line, tapiVersion, 0, 0,
			LINECALLPRIVILEGE_NONE, 0, @CallParams) < 0 then
		begin
		lineShutDown(lineApp);
		lineApp := 0;
		line := 0;
		end;
	if line = 0 then
		Memo1.Lines.Add('Error!!');
	end;

procedure TfrmTAPICall.FormDestroy(Sender: TObject);
	begin
	{ 终止TAPI,释放当前窗体，推出程序后才执行 }
	if line <> 0 then
		lineClose(line);
	if lineApp <> 0 then
		lineShutDown(lineApp);
	frmMain.Call := False;
	end;

  { 关闭窗体}  
procedure TfrmTAPICall.FormClose(Sender: TObject;
		var Action: TCloseAction);
	begin
	Action := caFree;
	end;

//对输入的电话号码进行拨号
procedure TfrmTAPICall.btnCallClick(Sender: TObject);
	var
		c: array[0..30] of char;
	begin
	if Length(Edit1.Text) > 0 then
		begin
		Memo1.Lines.Clear;
		StrPCopy(c, Edit1.Text);
		if lineMakeCall(line, call, c, 0, @CallParams) < 0 then
			Memo1.Lines.Add('Error in lineMakeCall')
		else
			begin
			btnCall.Enabled := False;
			btnDropCall.Enabled := True;
			end;
		end;
	end;

//挂调当前呼叫
procedure TfrmTAPICall.btnDropCallClick(Sender: TObject);
	begin
	if LineDrop(call, nil, 0) < 0 then
		Memo1.Lines.Add('Error in lineDrop')
	end;

//设定呼叫的类型  
procedure TfrmTAPICall.grpModeClick(Sender: TObject);
	begin
	if grpMode.ItemIndex = 0 then
    //交互语音呼叫
		CallParams.dwMediaMode := LINEMEDIAMODE_INTERACTIVEVOICE
	else
    //数据modem呼叫
		CallParams.dwMediaMode := LINEMEDIAMODE_DATAMODEM;
	end;

end.