unit uMyTapiObj;
interface
uses tapi,
Dialogs, SysUtils, ShellAPI, windows, Forms;
const
{$IFDEF Win32}
TapiDll = '
tapi32.dll';
{$ELSE}
TapiDll = '
tapi.dll';
{$ENDIF}
TAPI_HiVer = $00030000;
// Highest API version wanted (3.0)
TAPI_LoVer = $00010004;
// Lowest API version accepted (1.4)
TAPI_NegHi = $00030000;
// High API Version for negotiation purposes
TAPI_NegLo = $00010000;
// Low API Version for negotiation purposes
maxBufSize = $3FF;
// Größe des Datenbuffers für Datenrückgabe
// (Stichwort: Variabler Teil für Strings)
LINE_PROGRAMCHECK = 127;
// Virtuelle TAPI_Message für Timer-gesteuerte Checks
type
TLineCallbacks =
array of TLineCallBack;
// Nimmt die Adressen der gesetzten Callbackroutinen auf
//****************************************************************************
// TMyTapi: Klasse für die Tapi selbst
// die Instanz MyTapi muss created und initialized werden, da diese
// den callback mechanismus implementiert.
// Beim Aufruf von initialize muss ein Pointer auf die Callback Routine
// im aufrufenden Modul übergeben werden.
//****************************************************************************
TMyTapi =
class(TObject)
private
priv_Initialized: boolean;
priv_LineApp: HLINEAPP;
priv_hInstance: Cardinal;
priv_IDStr: PChar;
priv_NumDevs: Cardinal;
priv_Version: Cardinal;
priv_LineInitializeExParams: LineInitializeExParams_tag;
priv_LineCallback: TLineCallbacks;
priv_CallbackCount: integer;
function AddCall(Line: integer; CallHandle: hCall): boolean;
function RemoveCall(CallHandle: hCall): boolean;
public
constructor Create;
destructor Destroy;
override;
procedure AddCallback(CallbackProcedure: TLineCallback);
// Hinzufügen einer Callback Routine
procedure RemoveCallBack(CallbackProcedure: TLineCallback);
// Entfernen einer Callback Routine
property CallbackCount: integer
read priv_CallbackCount;
// Anzahl der hinzugefügten Callback Routinen
property ID_Str: PChar
read priv_IDStr;
function Initialize: boolean;
property Initialized: boolean
read priv_Initialized;
property LineApp: HLINEAPP
read priv_LineApp;
property NumDevs: cardinal
read priv_NumDevs;
property TAPI_Version:
string read get_Version;
end;
//******************************************************************************
// MyTapi muß erzeugt und initialisiert werden !!!
// wird von allen Objekten benutzt um auf Tapi Funktionen zuzugreifen
//******************************************************************************
var
MyTapi: TMyTapi;
implementation
//******************************************************************************
// Master Callback Routine
// - Kümmert sich um neue Calls und löscht diese bei LINECALLSTATE_IDLE
// - ruft alle registrierten callback Routinen auf
//******************************************************************************
procedure priv_MyCallback(hDevice,
dwMsg,
dwCallbackInstance,
dwParam1,
dwParam2,
dwParam3: Cardinal);
stdcall;
var i: integer;
begin
try
case dwMsg
of
LINE_PROGRAMCHECK:
begin
end;
LINE_APPNEWCALL:
begin
if MyTapi.priv_SupportCalls
then MyTapi.AddCall(dwCallbackInstance, dwParam2);
end;
LINE_CALLSTATE:
begin
if MyTapi.priv_SupportCalls
then begin
i := low(MyTapi.priv_calls);
while (MyTapi.priv_calls[i].priv_CallHandle <> hDevice)
and (i < high(MyTapi.priv_calls))
do
inc(i);
if MyTapi.priv_calls[i].priv_CallHandle = hDevice
then begin
if (dwParam1 = LINECALLSTATE_IDLE)
then MyTapi.RemoveCall(hDevice)
else MyTapi.priv_Calls[i].initialize(hDevice);
end else begin
MyTapi.AddCall(dwCallbackInstance, hDevice);
end;
end;
end;
LINE_CALLINFO:
begin
if MyTapi.priv_SupportCalls
then begin
i := low(MyTapi.priv_calls);
while (MyTapi.priv_calls[i].priv_CallHandle <> hDevice)
and (i < high(MyTapi.priv_calls))
do
inc(i);
if MyTapi.priv_calls[i].priv_CallHandle = hDevice
then begin
MyTapi.priv_Calls[i].initialize(hDevice);
end;
end;
end;
LINE_CLOSE,
LINE_CREATE,
LINE_REMOVE:
begin
(*if (*)shellexecute(Application.Handle,
'
open',
PChar(ParamStr(0)),
nil,
PChar(ExtractFilePath(ParamStr(0))),
SW_SHOWNORMAL)
(* <= 32)
then ShowMessage('Bitte Telefonliste neu starten!')*);
Application.MainForm.Close;
Application.Terminate;
end;
else begin
// MyTapi.ShowWarning('Code: ' + IntToStr(dwMsg) +
// ', Line: ' + IntToStr(dwCallbackInstance), 'priv_MyCallback');
end;
end;
if MyTapi <>
nil then if MyTapi.Initialized
then begin
for i := 0
to MyTapi.CallbackCount - 1
do begin
MyTapi.priv_LineCallback[i](hDevice, dwMsg, dwCallbackInstance,
dwParam1, dwParam2, dwParam3);
end;
if MyTapi.priv_debugging
then
try
MyTapi.priv_LogDebug(Tapi_Messages[dwMsg], IntToStr(dwCallbackInstance));
except
end;
end;
except
MyTapi.ShowWarning('
Error: priv_MyCallback', '
uMyTapiObj');
end;
end;
{ TTapiSP }
constructor TMyTapi.Create;
begin
inherited Create;
priv_Initialized := false;
priv_IDStr := '
Test';
priv_hInstance := hInstance;
nd;
destructor TMyTapi.Destroy;
begin
LogErrors := false;
priv_LineCallback :=
nil;
inherited Destroy;
MyTapi :=
nil;
end;
function TMyTapi.get_Version:
string;
begin
Result := IntToStr(priv_Version
div $10000) + '
.'
+ IntToStr(priv_Version
mod $10000);
end;
function TMyTapi.Initialize: boolean;
var i: integer;
begin
Result := false;
try
// initialisieren der MyLineInitializeExParams
FillChar(priv_LineInitializeExParams, SizeOf(priv_LineInitializeExParams), 0);
with priv_LineInitializeExParams
do begin
dwTotalSize := sizeof(priv_LineInitializeExParams);
// welcher Signalisierungstyp wird benutzt:
// LINEINITIALIZEEXOPTION_USEHIDDENWINDOW
// LINEINITIALIZEEXOPTION_USEEVENT
// LINEINITIALIZEEXOPTION_USECOMPLETIONPORT
dwOptions := LINEINITIALIZEEXOPTION_USEHIDDENWINDOW;
end;
priv_Version := TAPI_NegHi;
try
// Verbindungsaufnahme mit der TAPI
// - TAPI Version aushandeln, die maximal benutzt werden kann
// Callback Routine registrieren
// Anzahl der Lines
priv_Initialized := (lineInitializeEX(@priv_LineApp,
priv_hInstance,
priv_MyCallback,
priv_IDStr,
priv_NumDevs,
priv_Version,
priv_LineInitializeExParams) >= 0);
except
priv_Initialized := false;
end;
if priv_Initialized
then begin
SetLength(priv_Lines, priv_NumDevs);
for i := Low(priv_lines)
to High(priv_lines)
do begin
priv_Lines[i] := TMyInnoLine.Create;
priv_Lines[i].Initialize(i);
if priv_Lines[i].isInno
and priv_SupportCalls
then priv_Lines[i].LookForNewCalls;
end;
end;
Result := priv_Initialized;
except
ShowWarning('
Error: TMyTapi.Initialize', '
uMyTapiObj');
end;
end;
//******************************************************************************
// Einen neuen Call in die Liste aufnehmen
//******************************************************************************
function TMyTapi.AddCall(Line: Integer; CallHandle: hCall): boolean;
var i: integer;
newLength: integer;
begin
try
if priv_SupportCalls
then begin
inc(priv_CallCount);
SetLength(priv_Calls, priv_CallCount);
i := high(priv_calls);
priv_Calls[i] := TMyCall.Create;
Result := priv_Calls[i].initialize(CallHandle);
if Result
then begin
newLength := High(priv_Lines[Line].priv_MyCalls) + 2;
SetLength(priv_Lines[Line].priv_MyCalls, newLength);
priv_Lines[Line].priv_MyCalls[newLength - 1] := priv_Calls[i];
end;
end else begin
Result := false;
ShowWarning('
Support of Calls disabled', '
MyTapi.AddCall');
end;
except
Result := false;
ShowWarning('
Error: TMyTapi.AddCall', '
uMyTapiObj');
end;
end;
//******************************************************************************
// Einen bestehenden Call aus der Liste löschen
//******************************************************************************
function TMyTapi.RemoveCall(CallHandle: hCall): boolean;
var i, j: integer;
i2, j2, k2: integer;
begin
try
if priv_SupportCalls
then begin
i := low(priv_calls);
while (priv_calls[i].priv_CallHandle <> CallHandle)
and (i < high(priv_calls))
do
inc(i);
if priv_calls[i].priv_CallHandle = CallHandle
then begin
for i2 := Low(priv_Lines)
to High(priv_Lines)
do begin
for j2 := Low(priv_Lines[i2].priv_MyCalls)
to High(priv_Lines[i2].priv_MyCalls)
do begin
if priv_Lines[i2].priv_MyCalls[j2].priv_CallHandle = CallHandle
then begin
for k2 := j2
to High(priv_Lines[i2].priv_MyCalls) - 1
do begin
priv_Lines[i2].priv_MyCalls[k2] := priv_Lines[i2].priv_MyCalls[k2 + 1];
end;
SetLength(priv_Lines[i2].priv_MyCalls, High(priv_Lines[i2].priv_MyCalls));
end;
end;
end;
priv_calls[i].Destroy;
for j := i
to high(priv_Calls) - 1
do priv_Calls[j] := priv_Calls[j + 1];
dec(priv_CallCount);
Setlength(priv_Calls, priv_Callcount);
Result := true;
end else begin
Result := false;
end;
if Result
then begin
end;
end else begin
Result := false;
ShowWarning('
Support of Calls disabled', '
MyTapi.RemoveCall');
end;
except
Result := false;
ShowWarning('
Error: TMyTapi.RemoveCall', '
uMyTapiObj');
end;
end;
//******************************************************************************
// Eine Callback Routine registrieren
//******************************************************************************
procedure TMyTapi.AddCallback(CallbackProcedure: TLineCallback);
begin
try
inc(priv_CallbackCount);
SetLength(priv_LineCallback, priv_CallbackCount);
priv_LineCallback[High(priv_LineCallback)] := CallbackProcedure;
except
ShowWarning('
Error: TMyTapi.AddCallback', '
uMyTapiObj');
end;
end;
//******************************************************************************
// Registrierung einer Callback Routine entfernen
//******************************************************************************
procedure TMyTapi.RemoveCallBack(CallbackProcedure: TLineCallback);
var i, j: integer;
begin
try
i := Low(priv_LineCallback);
while (@priv_LineCallback[i] <> @CallbackProcedure)
and (i < High(priv_LineCallback))
do inc(i);
if @priv_LineCallback[i] = @CallbackProcedure
then begin
for j := i
to High(priv_LineCallback) - 1
do priv_LineCallback[j] := priv_LineCallback[j + 1];
dec(priv_CallbackCount);
SetLength(priv_LineCallback, priv_CallbackCount);
end else begin
ShowWarning('
Warning: can''
t remove Callback!', '
uMyTapiObj');
end;
except
ShowWarning('
Error: TMyTapi.RemoveCallback', '
uMyTapiObj');
end;
end;
function TMyTapi.getMemStr(Buffer: TBuffer; Offset, Size: Cardinal):
string;
var s:
string;
c: char;
i: integer;
begin
s := '
';
try
try
for i := Offset
to Offset + Size - 1
do begin
c := Buffer[i];
if c
in [#0..#31]
then c := '
';
s := s + c;
end;
except
ShowWarning('
Error: TMyTapi.getMemStr', '
uMyTapiObj');
raise;
end;
finally
Result := s;
end;
end;
end.