?? callform.pas
字號:
unit Callform;
{
*** TAPI Monitor ***
by Davide Moretti <dave@rimini.com>
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -