tapicom.pas

boomerang library 5.11 internet ed

(* TAPICom - TAPI connecting library
 * Copyright (C) 2001 Tomas Mandys-MandySoft
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA  02111-1307  USA
 *)

{ URL: http://www.2p.cz }

unit TAPICom;

{ TAPICom.htx }

interface
uses
  Windows, Classes, SysUtils, Connect, CommConnect, TAPI, Forms;

const
  TAPIHiVer = $00020000;  // Highest API version wanted (2.0)
  TAPILoVer = $00010004;  // Lowest API version accepted (1.4)

  TapiCallbacks = [LINE_CREATE, LINE_REMOVE, LINE_REQUEST];
  CallCallbacks = [LINE_ADDRESSSTATE, LINE_AGENTSPECIFIC, LINE_AGENTSTATUS, LINE_APPNEWCALL, LINE_CLOSE, LINE_LINEDEVSTATE, LINE_PROXYREQUEST];
  LineCallbacks = [LINE_CALLINFO, LINE_CALLSTATE, LINE_GATHERDIGITS, LINE_GENERATE, LINE_MONITORDIGITS, LINE_MONITORMEDIA, LINE_MONITORTONE];
  NoDeviceCallbacks = [LINE_REPLY];

type
  TLineCom = class;

  TCallback = procedure(Sender: TObject; aBusy: Boolean) of object;
  TTAPIHandleCallback = procedure(aDevice, aMessage, aInstance, aParam1, aParam2, aParam3: DWORD) of object;
  THandleCallback = procedure(aDevice, aMessage, aParam1, aParam2, aParam3: DWORD) of object;

  TTAPILine = class(TConnection)
  private
    FList: TList;
    FLineApp: hLineApp;
    FNumDevs : Integer;
    FKeepConnection: Boolean;
    FOnHandleCallback: TTAPIHandleCallback;
    procedure CloseAll;
    function GetCount: Integer;
    function GetLine(Index: Integer): TLineCom;
    function GetLineName(aDeviceId: DWORD): string;
    function GetAPIVersion(aDeviceId: DWORD): DWORD;
    function GetDevConfig(aDeviceId: DWORD): string;
    procedure SetDevConfig(aDeviceId: DWORD; const Value: string);
  protected
    procedure OpenConn; override;
    procedure CloseConn; override;
    procedure HandleCallback(aDevice, aMessage, aInstance, aParam1, aParam2, aParam3: DWORD); virtual;
  public
    property LineApp: hLineApp read FLineApp;
    property NumDevs : Integer read FNumDevs; {Number of TAPI devices}
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddLine(aLine: TLineCom);
    procedure RemoveLine(aLine: TLineCom);
    procedure ShowConfigDialog(aDeviceId: DWORD);
    procedure ShowTranslateDialog(aDeviceId: DWORD; aPhoneNumber: string);
    function FindDeviceId(const aDeviceName: string): DWORD;
    property Count: Integer read GetCount;
    property Lines[Index: Integer]: TLineCom read GetLine; default;
    property LineNames[aDeviceId: DWORD]: string read GetLineName;
    property APIVersions[aDeviceId: DWORD]: DWORD read GetAPIVersion;
    property DevConfig[aDeviceId: DWORD]: string read GetDevConfig write SetDevConfig;
  published
    property KeepConnection: Boolean read FKeepConnection write FKeepConnection;
    property OnHandleCallback: TTAPIHandleCallback read FOnHandleCallback write FOnHandleCallback;
  end;

  TCallOffering = procedure(Sender: TObject; var aAnswer: Boolean) of object;
  TStateChange = procedure(Sender: TObject; aParam1, aParam2: DWORD) of object;

  TLineCommHandle = class(TCommHandle)
  private
    FLineCom: TLineCom;
  protected
    procedure DoAfterOpen; override;
    procedure DoAfterClose; override;
  public
  end;

  TLineCom = class(TConnection)
  private
    FDeviceId: DWORD;
    FLine: hLine;
    FCall : hCALL;
    FhCommDev: THandle;
    FPhoneNumber: string;
    FOnCallOffering: TCallOffering;
    FOnHandleCallback: THandleCallback;
    FOnConnect: TNotifyEvent;
    FOnDisconnect: TNotifyEvent;
    FOnCallAnswering: TNotifyEvent;
    FOnStateChange: TStateChange;
    FComm: TLineCommHandle;

    FDirectAccess: Boolean;
    FRequestAnswer: DWORD;
    FRequestMakeCall: DWORD;
    FRequestDrop: DWORD;
    procedure SetDeviceId(Value: DWORD);
    procedure CheckDeviceId;
    function GetLineApp: hLineApp;
    function GetAPIVersion: DWORD;
    function GetConnected: Boolean;
    procedure SetPhoneNumber(const Value: string);
    procedure SetDirectAccess(Value: Boolean);
    function GetTranslatedPhoneNumber: string;
    function GetDevConfig: string;
    procedure SetDevConfig(const Value: string);
    function GetIsMakingCall: Boolean;
    function GetIsDropping: Boolean;
    function GetIsAnswering: Boolean;
  protected
    procedure OpenConn; override;
    procedure CloseConn; override;
    procedure HandleCallback(aDevice, aMessage, aParam1, aParam2, aParam3: DWORD); virtual;
    procedure CheckConnected;
    procedure CheckDisconnected;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure ShowTranslateDialog;
    procedure MakeCall;
    procedure Drop;
    property LineApp: hLineApp read GetLineApp;
    property DeviceId: DWORD read FDeviceId write SetDeviceId;
    property APIVersion: DWORD read GetAPIVersion;
    property Line: hLine read FLine;
    property Call: hCall read FCall;
    property TranslatedPhoneNumber: string read GetTranslatedPhoneNumber;
    property Comm: TLineCommHandle read FComm;
    property IsMakingCall: Boolean read GetIsMakingCall;
    property IsDropping: Boolean read GetIsDropping;
    property IsAnswering: Boolean read GetIsAnswering;
    property DevConfig: string read GetDevConfig write SetDevConfig;
  published
    property Connected: Boolean read GetConnected;
    property DirectAccess: Boolean read FDirectAccess write SetDirectAccess;
    property PhoneNumber: string read FPhoneNumber write SetPhoneNumber;
    property OnCallOffering: TCallOffering read FOnCallOffering write FOnCallOffering;
    property OnHandleCallback: THandleCallback read FOnHandleCallback write FOnHandleCallback;
    property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
    property OnDisconnect: TNotifyEvent read FOnDisconnect write FOnDisconnect;
    property OnCallAnswering: TNotifyEvent read FOnCallAnswering write FOnCallAnswering;
    property OnStateChange: TStateChange read FOnStateChange write FOnStateChange;
  end;

function GetTapiMem(aSize: Integer): Pointer;   // allocatec memory in tapi structure, zero then and fill size

function LineCallStateToStr(CallState : DWORD) : string;
function LineCallStateInfoToStr(CallState, Info : DWORD) : string;

procedure Register;

var
  TAPILine: TTAPILine;

resourcestring
  stUnknownLineCallState = 'Unknown (%d)';
  stUndefinedLineCallStateInfo = 'Undefined (%d)';

  errBadDeviceId = 'Bad device id';
  errCallInProcess = 'Callin already in process';
  errNotConnected = 'Call not connected';
  errNotDisconnected = 'Call not disconnected';
  errVerifyUsable = '% is not supported';
  errLineIsAlreadyUsed = 'Line is already in use by a non-TAPI app or another service provider';
  errNotEnoughMemory = 'Not enough memory to allocate tapi data structure';

  stLineUnavail = '<Unavailable line>';
  stLineUnnamed = '<Noname line>';
  stLineNameEmpty = '<Empty line name>';

implementation
uses
  Dialogs;

function GetTapiMem;
const
  DataSize = 1024;
begin
  GetMem(Result, aSize+DataSize);
  if Result = nil then
    TapiError(errNotEnoughMemory);
  FillChar(Result^, aSize+DataSize, #0);
  DWORD(Result^):= aSize+DataSize;
end;

function _StrCopy(aStruct: Pointer; aOffset, aSize: DWORD): string;
var
  P: PChar;
begin
  GetMem(P, aSize+1);
  try
    StrMove(P, PChar (LONG(aStruct) + aOffset), aSize);
    P[aSize]:= #0;
    Result:= P;
  finally
    FreeMem(P);
  end;
end;

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:= Format(stUnknownLineCallState, [CallState]);
  end;
end;

function LineCallStateInfoToStr(CallState, Info : DWORD) : string;
begin
  Result:= '';
  if Info = 0 Then
     Result:='SUCCESS';
  case CallState of
    LINECALLSTATE_DIALTONE :
      case Info of
        LINEDIALTONEMODE_NORMAL : Result:='NORMAL';
        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: Result:='NODIALTONE';       // TAPI v1.4
      end;
  end;
  if Result = '' then
    Result:= Format(stUndefinedLineCallStateInfo, [Info]);
end;

procedure LineCallbackProc(aDeviceId, aMessage, aInstance, aParam1, aParam2, aParam3 : DWORD); {$IFDEF WIN32}stdcall{$ELSE}export{$ENDIF};
begin
  try
    TAPILine.HandleCallback(aDeviceId, aMessage, aInstance, aParam1, aParam2, aParam3);
  except
    on E: Exception do
      Application.HandleException(E);
  end;
end;

constructor TTAPILine.Create;
begin
  inherited Create(aOwner);
  FList := TList.Create;
end;

destructor TTAPILine.Destroy;
begin
  CloseAll;
  FList.Free;
  inherited Destroy;
end;

procedure TTAPILine.AddLine;
begin
  if FList.Count = 0 then
    Open;
  FList.Add(aLine);
end;

procedure TTAPILine.RemoveLine;
begin
  FList.Remove(aLine);
  if FList.Count = 0 then
    if not FKeepConnection then
      Close;
end;

procedure TTAPILine.CloseAll;
var
  I: Integer;
begin
  for I := FList.Count-1 downto 0 do
  begin
    TLineCom(FList[I]).Free;
    FList.Delete(I);
  end;
  if not FKeepConnection then
    Close;
end;

function TTAPILine.GetCount;
begin
  Result:= FList.Count;
end;

function TTAPILine.GetLine;
begin
  Result:= TLineCom(FList[Index]);
end;

procedure TTAPILine.OpenConn;
begin
  TapiCheck(lineInitialize(@FLineApp, SysInit.hInstance, LineCallbackProc, PChar(Application.Title), @FNumDevs));
end;

procedure TTAPILine.CloseConn;
begin
  TapiCheck(lineShutdown(FLineApp));
end;

function TTAPILine.GetLineName;
var
  lpLineDevCaps_: LPLINEDEVCAPS;
begin
  CheckActive;
  lpLineDevCaps_:= GetTapiMem(sizeof(TLINEDEVCAPS));