unit Tapi;
interface
uses Windows, Classes, Forms, Controls, StdCtrls, ExtCtrls, Messages, SysUtils, TapiTypeDef, Dialogs, Graphics;
type
// Develop-Test
TDevTest =
record
LineAppActive: Boolean;
LineActive: Boolean;
Text:
String;
end;
// Event-Prozeduren
TDevelopTestEvent =
procedure(Sender: TObject; DevTest: TDevTest)
of Object;
type
TTapi =
class(TScrollBox)
private
FLastMessage:
String;
FTapiList: TStringList;
FActiveTapiName:
String;
// Normale Ausgangs-Events
FDevelopTest: TDevelopTestEvent;
procedure DevTest(Text:
String = '
');
// Line-App zum generellen kommunizieren über Tapi-Funktionen - dient zur Aushandlung der API-Version
function CloseLineApp: Boolean;
function OpenLineApp: Boolean;
// Alle Tapi-Geräte erfassen
procedure GetTapiList;
// Tapi-Gerät öffnen und schließen
function OpenLine(ID: Cardinal): Boolean;
function CloseLine: Boolean;
// Verbindungen in Listen-Ketten verwalten
procedure FreeCallCon;
procedure AddCallCon(hCall: ThCall);
procedure DeleteCallCon(hCall: ThCall);
procedure SetCallConItem(hCall: ThCall; Kind: Byte; Item: Variant);
// Externes Eingangs-Event der Line-App (Alle aktiven Tapi's)
procedure LineAppCallBack(hDevice, dwMsg, dwCallbackInstance, dwParam1, dwParam2, dwParam3: DWORD);
stdcall;
// Visuelle Liste
procedure AddCallListItem(CallTime: TDateTime; Description:
String);
procedure ListItemMouseEnter(Sender: TObject);
procedure ListItemMouseLeave(Sender: TObject);
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
function Init: Boolean;
procedure Free;
function SetActiveTapi(
Name:
String): Boolean;
function Call(Num:
String): Boolean;
// Test
procedure DevTestFiller;
procedure DevTestPaint(Text:
String);
procedure FreeCallList;
published
property LastMessage:
String index 0
read FLastMessage;
property TapiList: TStringList
index 1
read FTapiList;
property ActiveTapiName:
String index 2
read FActiveTapiName;
property OnDevelopTest: TDevelopTestEvent
index 0
read FDevelopTest
write FDevelopTest;
end;
procedure Register;
implementation
// Privat
const
ListItemHeight = 20;
ListItemHSpace = 5;
ListItemVSpace = 3;
type
// Pointer-Kette für optische Liste in der Scrollbox
PCallList = ^TCallList;
TCallList =
record
ID: Cardinal;
// ID-Nr
PItem: TPanel;
// Panel zur optischen Trennung der Listeneinträge
LDescription: TLabel;
// Anruf-Informationen
SCallStatus: TShape;
// Ruf-Signalisierung
Next: PCallList;
// Pointer auf den nächsten Eintrag
end;
// Array der Tapi-Geräte
TTapiDevice =
record
ID: Cardinal;
// Feste ID des Tapi-Gerätes
Name:
String;
// Name des Tapi-Gerätes
APIVersion: Cardinal;
// Versions-Nummer zur Kontrolle der Kompatibilität zum Programm
end;
// Pointer-Kette für alle aktiven Rufe
PCallCon = ^TCallCon;
TCallCon =
record
hCall: ThCall;
// Handle zur Verbindung
Incomming: Boolean;
// Ein- oder ausgehender Ruf
CallerID:
String;
// Anrufer - Nummer
CalledID:
String;
// Anruf-Empfänger - Nummer
Connected: Boolean;
// Mit Teilnehmer verbunden
PListItem: PCallList;
// Pointer auf visuellen Listeneintrag
Speed: Cardinal;
Next: PCallCon;
// Pointer auf die nächste Verbindung
end;
// Tapi-Haupt-Record
TTapiPhone =
record
DevCount: Cardinal;
Devices:
Array of TTapiDevice;
// Liste der Tapi-Geräte
ActiveID: Cardinal;
// ID des aktiven Tapi-Gerätes
hLineApp: ThLineApp;
// Handle der Tapi-Schnittstelle
hLine: ThLine;
// Handle des aktiven Tapi-Gerätes
CallCon: PCallCon;
// Pointer auf die erste Verbindung (Ein-, Ausgehend, (nicht) angenommen, Konferenz, usw.)
end;
var
hTapiLib: THandle;
// Handle von DLL
lineInitializeExW: TlineInitializeExW;
lineGetCallInfoW: TlineGetCallInfoW;
lineNegotiateAPIVersion: TlineNegotiateAPIVersion;
lineGetDevCapsW: TlineGetDevCapsW;
lineClose: TlineClose;
lineOpenW: TlineOpenW;
lineShutdown: TlineShutdown;
lineMakeCallW: TlineMakeCallW;
InitOK: Boolean;
FirstCallListItem: PCallList;
TapiPhone: TTapiPhone;
SelfOfTTapi: TTapi;
(* ------------------------------- Erzeugen --------------------------------- *)
constructor TTapi.Create(AOwner: TComponent);
begin
inherited;
// Self zwischenspeichern - wird benötigt wenn DLL ein Event auslöst (damit Assign funktioniert)
SelfOfTTapi:=Self;
// ScrollBox formatieren
Self.DoubleBuffered:=True;
// Flicker-Frei beim verschieben, dafür mehr Speicherbelegung
Self.HorzScrollBar.Visible:=False;
Self.VertScrollBar.Tracking:=True;
// Beim Verschieben gleich zeichnen
// Speicher für Liste reservieren
FTapiList:=TStringList.Create;
// Listen-Ketten initialisieren
FirstCallListItem:=nil;
TapiPhone.CallCon:=nil;
end;
(* ------------------------------- Beenden ---------------------------------- *)
destructor TTapi.Destroy;
begin
Free;
// Speicher freigeben
FTapiList.Free;
FreeCallCon;
inherited;
end;
(* ----------------------------- Test - Ausgaben ---------------------------- *)
procedure TTapi.DevTest(Text:
String = '
');
var DevTest: TDevTest;
begin
if Assigned(onDevelopTest)
then begin
DevTest.LineAppActive:=TapiPhone.hLineApp>0;
DevTest.LineActive:=TapiPhone.hLine>0;
DevTest.Text:=Text;
onDevelopTest(Self, DevTest);
end;
end;
(* -------------------------- Tapi initialisieren --------------------------- *)
function TTapi.Init: Boolean;
var InitStateOK: Boolean;
begin
DevTest('
Init Start');
InitStateOK:=True;
if hTapiLib=0
then begin
// DLL laden
hTapiLib:=LoadLibrary(TapiDllName);
if hTapiLib>0
then begin
try
// Speicher für benötigte Funktionen reservieren
@lineInitializeExW:=GetProcAddress(hTapiLib, '
lineInitializeExW');
@lineGetCallInfoW:=GetProcAddress(hTapiLib, '
lineGetCallInfoW');
@lineNegotiateAPIVersion:=GetProcAddress(hTapiLib, '
lineNegotiateAPIVersion');
@lineGetDevCapsW:=GetProcAddress(hTapiLib, '
lineGetDevCapsW');
@lineClose:=GetProcAddress(hTapiLib, '
lineClose');
@lineOpenW:=GetProcAddress(hTapiLib, '
lineOpenW');
@lineShutdown:=GetProcAddress(hTapiLib, '
lineShutdown');
@lineMakeCallW:=GetProcAddress(hTapiLib, '
lineMakeCallW');
except
on E:
Exception do begin
InitStateOK:=False;
FLastMessage:=E.
message+#13#10+SysErrorMessage(GetLastError);
end;
end;
end;
end else FLastMessage:='
Die Datei "'+TapiDllName+'
" konnte nicht geladen werden.';
if InitStateOK
then begin
// Tapi-App öffnen
if TapiPhone.hLineApp=0
then if OpenLineApp=False
then InitStateOK:=False;
// Tapi-Liste erfassen
if InitStateOK
then GetTapiList;
end;
InitOK:=InitStateOK;
Result:=InitStateOK;
DevTest('
Init End');
end;
(* ------------------------------ Tapi beenden ------------------------------ *)
procedure TTapi.Free;
begin
InitOK:=False;
// Falls aktiv
if TapiPhone.hLine>0
then CloseLine;
// Tapi-App beenden
if TapiPhone.hLineApp>0
then CloseLineApp;
// Speicher freigeben
SetLength(TapiPhone.Devices, 0);
// DLL entladen
if hTapiLib>0
then begin
FreeLibrary(hTapiLib);
hTapiLib:=0;
end;
end;
(* ---------------------------- LineApp öffnen ------------------------------ *)
function TTapi.OpenLineApp: Boolean;
var ret: Cardinal;
LineIExParams: TLineInitializeExParams;
begin
DevTest('
OpenLineApp Start');
Result:=False;
LineIExParams.dwTotalSize:=SizeOf(LineIExParams);
LineIExParams.dwOptions:=LINEINITIALIZEEXOPTION_USEHIDDENWINDOW;
ret:=lineInitializeExW(@TapiPhone.hLineApp, SysInit.HInstance, @TTapi.LineAppCallBack, '
TapiConsoleMonitor', @TapiPhone.DevCount, @APIHighVer, @LineIExParams);
if ret=0
then Result:=True
else FLastMessage:=GetTapiErrorMessage(ret);
DevTest('
OpenLineApp End');
end;
(* --------------------------- LineApp schließen ---------------------------- *)
function TTapi.CloseLineApp: Boolean;
var ret: Cardinal;
begin
DevTest('
CloseLineApp Start');
Result:=False;
ret:=lineShutdown(TapiPhone.hLineApp);
TapiPhone.hLineApp:=0;
if ret=0
then Result:=True
else FLastMessage:=GetTapiErrorMessage(ret);
DevTest('
CloseLineApp End');
end;
(* ------------------------- Tapi-Geräte erfassen --------------------------- *)
procedure TTapi.GetTapiList;
var ret, X, DeviceID, Offset, Size, DevAPIVersion: Cardinal;
LineExId: TLineExtentionId;
Buffer:
Array of Byte;
begin
DevTest('
GetTapiList Start');
SetLength(TapiPhone.Devices, 0);
ret:=0;
// Alle Tapi-Geräte erfassen
for X:=0
to TapiPhone.DevCount-1
do begin
if ret>0
then DevTest('
Device '+IntToStr(X)+'
:'+GetTapiErrorMessage(ret));
// Prüfen ob das Tapi-Gerät mit der API-Version kompatibel ist
ret:=lineNegotiateAPIVersion(TapiPhone.hLineApp, X, APILowVer, APIHighVer, @DevAPIVersion, @LineExId);
if ret>0
then Continue;
// Vorabfrage, wg. der benötigten Größe (dwNeededSize)
SetLength(Buffer, SizeOf(TLineDevCaps));
TLineDevCaps(Pointer(Buffer)^).dwTotalSize:=Length(Buffer);
ret:=lineGetDevCapsW(TapiPhone.hLineApp, X, DevAPIVersion, 0, @Buffer[0]);
if ret>0
then Continue;
// Größe von Buffer anpassen
SetLength(Buffer, TLineDevCaps(Pointer(Buffer)^).dwNeededSize);
TLineDevCaps(Pointer(Buffer)^).dwTotalSize:=Length(Buffer);
// Abfrage DevCaps
ret:=lineGetDevCapsW(TapiPhone.hLineApp, X, DevAPIVersion, 0, @Buffer[0]);
if ret>0
then Continue;
// Ort und Länge des Namens erfassen
Offset:=TLineDevCaps(Pointer(Buffer)^).dwLineNameOffset;
Size:=TLineDevCaps(Pointer(Buffer)^).dwLineNameSize;
// Gerät erfassen
DeviceID:=Length(TapiPhone.Devices);
SetLength(TapiPhone.Devices, DeviceID+1);
TapiPhone.Devices[DeviceID].ID:=X;
if Size>0
then TapiPhone.Devices[DeviceID].
Name:=PWideChar(@Buffer[Offset]);
TapiPhone.Devices[DeviceID].APIVersion:=DevAPIVersion;
end;
// Liste füllen
FTapiList.Clear;
for X:=0
to Length(TapiPhone.Devices)-1
do FTapiList.Add(TapiPhone.Devices[X].
Name);
// Speicher freigeben
SetLength(Buffer, 0);
DevTest('
GetTapiList End');
end;
(* ------------------------------ Line öffnen ------------------------------- *)
function TTapi.OpenLine(ID: Cardinal): Boolean;
var ret, ExtVersion, CallbackInstance, Privileges, MediaModes: Cardinal;
begin
DevTest('
OpenLine Start');
Result:=False;
ExtVersion:=0;
CallbackInstance:=0;
Privileges:=LINECALLPRIVILEGE_MONITOR
or LINECALLPRIVILEGE_OWNER;
// Die Leitung für einen Monitor öffnen
// Media - Modes
// LINEMEDIAMODE_AUTOMATEDVOICE | LINEMEDIAMODE_DATAMODEM | LINEMEDIAMODE_ADSI | LINEMEDIAMODE_DIGITALDATA
// LINEMEDIAMODE_G3FAX | LINEMEDIAMODE_G4FAX | LINEMEDIAMODE_INTERACTIVEVOICE | LINEMEDIAMODE_MIXED
// LINEMEDIAMODE_TDD | LINEMEDIAMODE_TELETEX | LINEMEDIAMODE_TELEX | LINEMEDIAMODE_VIDEO
// LINEMEDIAMODE_VIDEOTEX | LINEMEDIAMODE_VOICEVIEW | LINEMEDIAMODE_UNKNOWN
MediaModes:=LINEMEDIAMODE_INTERACTIVEVOICE;
// Line öffnen
ret:=lineOpenW(TapiPhone.hLineApp, TapiPhone.Devices[ID].ID, @TapiPhone.hLine, TapiPhone.Devices[ID].APIVersion, ExtVersion, CallbackInstance, Privileges, MediaModes,
nil);
if ret=0
then Result:=True
else FLastMessage:=GetTapiErrorMessage(ret);
DevTest('
OpenLine End');
end;
(* ---------------------------- Line schließen ------------------------------ *)
function TTapi.CloseLine: Boolean;
var ret: Cardinal;
begin
DevTest('
CloseLine Start');
Result:=False;
ret:=lineClose(TapiPhone.hLine);
TapiPhone.hLine:=0;
if ret=0
then Result:=True
else FLastMessage:=GetTapiErrorMessage(ret);
DevTest('
CloseLine End');
end;
(* -------------------------- Tapi-Gerät aktivieren ------------------------- *)
function TTapi.SetActiveTapi(
Name:
String): Boolean;
var X, ID: Integer;
begin
DevTest('
SetActiveTapi Start');
Result:=False;
// Falls ein Tapi-Gerät aktiviert -> beenden
if TapiPhone.hLine>0
then CloseLine;
FActiveTapiName:='
';
// Name suchen
ID:=-1;
for X:=0
to Length(TapiPhone.Devices)-1
do begin
if TapiPhone.Devices[X].Name=Name
then begin
ID:=X;
Break;
end;
end;
if ID=-1
then begin
FLastMessage:='
Tapi-Gerät "'+
Name+'
" nicht gefunden.';
Exit;
end;
// Tapi-Gerät öffnen
if OpenLine(ID)=False
then Exit;
// Name hinterlegen
FActiveTapiName:=Name;
Result:=True;
DevTest('
SetActiveTapi End');
end;
(* -------------- Speicher für Einfache Listen-Kette freigeben -------------- *)
procedure TTapi.FreeCallCon;
var TmpCallCon: PCallCon;
begin
if TapiPhone.CallCon<>
nil then begin
// Speicher der Untergeordneten Verweise freigeben
while TapiPhone.CallCon^.Next<>
nil do begin
TmpCallCon:=TapiPhone.CallCon^.Next;
Dispose(TapiPhone.CallCon);
TapiPhone.CallCon:=TmpCallCon;
end;
// Ersten Verweis freigeben
Dispose(TapiPhone.CallCon);
end;
end;
(* ---------------- Neues Element der Listen-Kette hinzufügen --------------- *)
procedure TTapi.AddCallCon(hCall: ThCall);
var NewCallCon, TmpCallCon: PCallCon;
begin
// Speicher reservieren
New(NewCallCon);
// Prüfen ob es sich um das Root-Element handelt
if TapiPhone.CallCon=nil
then TapiPhone.CallCon:=NewCallCon
else begin
// Root-Element zwischenspeichern
TmpCallCon:=TapiPhone.CallCon;
// Letztes Element suchen
while TmpCallCon^.Next<>
nil do TmpCallCon:=TmpCallCon^.Next;
// Verweis auf neues Element setzen
TmpCallCon^.Next:=NewCallCon;
end;
// Veriablen setzen
NewCallCon^.hCall:=hCall;
NewCallCon^.Incomming:=False;
NewCallCon^.CallerID:='
';
NewCallCon^.CalledID:='
';
NewCallCon^.Connected:=False;
NewCallCon^.Speed:=GetTickCount;
// Verweis auf ein weiteres Element verhindern
NewCallCon^.Next:=nil;
end;
(* ------------------- Element aus der Listen-Kette löschen ----------------- *)
procedure TTapi.DeleteCallCon(hCall: ThCall);
var PreCallCon, TmpCallCon: PCallCon;
begin
// Prüfen ob Root existiert
if TapiPhone.CallCon=nil
then Exit;
// Erstes Element übernehmen
TmpCallCon:=TapiPhone.CallCon;
// Zwischen-Speicher für davor und danach initialisieren
PreCallCon:=nil;
repeat
// Prüfen ob das zu löschende Handle erreicht ist
if TmpCallCon^.hCall=hCall
then begin
if PreCallCon=nil
then TapiPhone.CallCon:=TmpCallCon^.Next
else PreCallCon^.Next:=TmpCallCon^.Next;
Dispose(TmpCallCon);
Exit;
end;
// Vorhergendes Element zwischenspeichern
PreCallCon:=TmpCallCon;
// Nächstes Element übernehmen
TmpCallCon:=TmpCallCon^.Next;
until TmpCallCon=nil;
end;
(* ------------ Element-Eintrag in der Listen-Kette editieren --------------- *)
procedure TTapi.SetCallConItem(hCall: ThCall; Kind: Byte; Item: Variant);
var TmpCallCon: PCallCon;
begin
if TapiPhone.CallCon=nil
then Exit;
// Element suchen
TmpCallCon:=TapiPhone.CallCon;
repeat
// Element gefunden
if TmpCallCon^.hCall=hCall
then begin
// Item eintragen
case Kind
of
0 : TmpCallCon^.Incomming:=Item;
1 : TmpCallCon^.CallerID:=Item;
2 : TmpCallCon^.CalledID:=Item;
3 : TmpCallCon^.Connected:=Item;
100 : TmpCallCon^.Speed:=GetTickCount-TmpCallCon^.Speed;
end;
end;
TmpCallCon:=TmpCallCon^.Next;
until TmpCallCon=nil;
end;
(* ---------------- Neues Element der Listen-Kette hinzufügen --------------- *)
procedure TTapi.AddCallListItem(CallTime: TDateTime; Description:
String);
var X: Cardinal;
NewCallListItem, TmpCallListItem: PCallList;
NewItemWidth, OrgClientWidth: Integer;
begin
// Breite der Panels bestimmen
OrgClientWidth:=Self.ClientWidth;
NewItemWidth:=OrgClientWidth-ListItemHSpace*2;
// Speicher reservieren
New(NewCallListItem);
X:=0;
// Prüfen ob es sich um das Root-Element handelt
if FirstCallListItem=nil
then FirstCallListItem:=NewCallListItem
else begin
// Root-Element zwischenspeichern
TmpCallListItem:=FirstCallListItem;
// Element nach unten verschieben
TmpCallListItem^.PItem.Top:=TmpCallListItem^.PItem.Top+ListItemVSpace+ListItemHeight;
TmpCallListItem^.PItem.Width:=NewItemWidth;
Inc(X);
// Letztes Element suchen
while TmpCallListItem^.Next<>
nil do begin
// Nächstes Element
TmpCallListItem:=TmpCallListItem^.Next;
// Element nach unten verschieben
TmpCallListItem^.PItem.Top:=TmpCallListItem^.PItem.Top+ListItemVSpace+ListItemHeight;
TmpCallListItem^.PItem.Width:=NewItemWidth;
// ID
Inc(X);
end;
// Verweis auf neues Element setzen
TmpCallListItem^.Next:=NewCallListItem;
end;
// Variablen setzen
NewCallListItem^.ID:=X;
// Panel erzeugen
NewCallListItem^.PItem:=TPanel.Create(Self);
NewCallListItem^.PItem.
Name:='
PCallItem'+IntToStr(X);
NewCallListItem^.PItem.Visible:=False;
NewCallListItem^.PItem.Caption:='
';
NewCallListItem^.PItem.Parent:=Self;
NewCallListItem^.PItem.Left:=ListItemHSpace;
NewCallListItem^.PItem.Top:=ListItemVSpace;
NewCallListItem^.PItem.Width:=NewItemWidth;
NewCallListItem^.PItem.Height:=ListItemHeight;
// Panel-Events
NewCallListItem^.PItem.OnMouseEnter:=ListItemMouseEnter;
NewCallListItem^.PItem.OnMouseLeave:=ListItemMouseLeave;
// Label erzeugen
NewCallListItem^.LDescription:=TLabel.Create(NewCallListItem^.PItem);
NewCallListItem^.LDescription.
Name:='
LCallItemDescription'+IntToStr(X);
NewCallListItem^.LDescription.Caption:=FormatDateTime('
dd.mm.yy - hh:nn', CallTime)+'
'+Description+'
- '+IntTostr(X);
NewCallListItem^.LDescription.Parent:=NewCallListItem^.PItem;
NewCallListItem^.LDescription.Left:=10;
NewCallListItem^.LDescription.Top:=Round(ListItemHeight/2+NewCallListItem^.LDescription.Font.Height/2);
// Shape erzeugen
NewCallListItem^.SCallStatus:=TShape.Create(NewCallListItem^.PItem);
NewCallListItem^.SCallStatus.
Name:='
SCallItemStatus'+IntToStr(X);
NewCallListItem^.SCallStatus.Parent:=NewCallListItem^.PItem;
NewCallListItem^.SCallStatus.Shape:=stCircle;
NewCallListItem^.SCallStatus.Width:=Round(ListItemHeight*0.7);
NewCallListItem^.SCallStatus.Height:=NewCallListItem^.SCallStatus.Width;
NewCallListItem^.SCallStatus.Left:=NewCallListItem^.PItem.Width-NewCallListItem^.SCallStatus.Width-10;
NewCallListItem^.SCallStatus.Top:=Round(ListItemHeight/2-NewCallListItem^.SCallStatus.Height/2);
NewCallListItem^.SCallStatus.Anchors:=[akTop, akRight];
// Shape Rechtsbündig
// Verweis auf ein weiteres Element verhindern
NewCallListItem^.Next:=nil;
// Kontrollieren ob sich die ScrollBar eingeschlatet hat -> Breite aller zuvorgesetzten Elemente korrigieren
if OrgClientWidth<>Self.ClientWidth
then begin
NewItemWidth:=Self.ClientWidth-ListItemHSpace*2;
// Root-Element zwischenspeichern
TmpCallListItem:=FirstCallListItem;
// neue Breite
TmpCallListItem^.PItem.Width:=NewItemWidth;
// Letztes Element suchen
while TmpCallListItem^.Next<>
nil do begin
// Nächstes Element
TmpCallListItem:=TmpCallListItem^.Next;
// neue Breite
TmpCallListItem^.PItem.Width:=NewItemWidth;
end;
end;
// Panel anzeigen
NewCallListItem^.PItem.Visible:=True;
end;
(* -------------- Speicher für Einfache Listen-Kette freigeben -------------- *)
procedure TTapi.FreeCallList;
var TmpCallListItem: PCallList;
begin
if FirstCallListItem<>
nil then begin
// Speicher der Untergeordneten Verweise freigeben
while FirstCallListItem^.Next<>
nil do begin
TmpCallListItem:=FirstCallListItem^.Next;
FirstCallListItem^.PItem.Visible:=False;
FreeAndNil(FirstCallListItem^.LDescription);
FreeAndNil(FirstCallListItem^.SCallStatus);
FreeAndNil(FirstCallListItem^.PItem);
Dispose(FirstCallListItem);
FirstCallListItem:=TmpCallListItem;
end;
// Ersten Verweis freigeben
FirstCallListItem^.PItem.Visible:=False;
FreeAndNil(FirstCallListItem^.LDescription);
FreeAndNil(FirstCallListItem^.SCallStatus);
FreeAndNil(FirstCallListItem^.PItem);
Dispose(FirstCallListItem);
FirstCallListItem:=nil;
end;
end;
(* --------------------- Visuelle Liste zum Test füllen --------------------- *)
procedure TTapi.DevTestFiller;
begin
AddCallListItem(Date+Time-1, '
Herr Black');
AddCallListItem(Date+Time-0.8, '
Frau Haumichblau');
AddCallListItem(Date+Time-0.6, '
Monsinore von der Wehe');
AddCallListItem(Date+Time-0.4, '
Gewerbeküche (57)');
end;
procedure TTapi.DevTestPaint(Text:
String);
var DC: HDC;
Canvas: TCanvas;
begin
DC := GetWindowDC(GetDesktopWindow());
try
Canvas := TCanvas.Create();
try
Canvas.Handle :=
DC;
Canvas.Pen.Color := clLime;
Canvas.Rectangle(1,1,200,500);
Canvas.Font.Size:=16;
Canvas.TextOut(1,1, Text);
finally
Canvas.Free;
end;
finally
ReleaseDC(0,
DC);
end;
end;
(* ------------------------------ Maus - Move ------------------------------- *)
procedure TTapi.ListItemMouseEnter(Sender: TObject);
begin
if Sender
is TPanel
then TPanel(Sender).Color:=clLime;
end;
(* ----------------------------- Maus - Leave ------------------------------- *)
procedure TTapi.ListItemMouseLeave(Sender: TObject);
begin
if Sender
is TPanel
then TPanel(Sender).Color:=clBtnFace;
end;
(* -------------- Event von Tapi-Schnittstelle verarbeiten ------------------ *)
procedure TTapi.LineAppCallBack(hDevice, dwMsg, dwCallbackInstance, dwParam1, dwParam2, dwParam3: DWORD);
stdcall;
var ret, X, Size, Offset, CallState: Cardinal;
Tmpstr:
String;
Buffer:
Array of Byte;
LCI: TLineCallInfo;
label Quit;
begin
// Self ist nil, wenn DLL das Event erzeugt hat
if Self<>SelfOfTTapi
then Self:=SelfOfTTapi;
// hDev enthält ein line- oder call-Handle, zu erfahren über dwMsg
DevTest('
LineAppCallBack Start');
DevTest('
hDevice: '+IntTostr(hDevice));
case dwMsg
of
LINE_ADDRESSSTATE : TmpStr:='
LINE_ADDRESSSTATE';
LINE_CALLINFO : TmpStr:='
LINE_CALLINFO';
LINE_CALLSTATE : TmpStr:='
LINE_CALLSTATE';
LINE_CLOSE : TmpStr:='
LINE_CLOSE';
LINE_DEVSPECIFIC : TmpStr:='
LINE_DEVSPECIFIC';
LINE_DEVSPECIFICFEATURE : TmpStr:='
LINE_DEVSPECIFICFEATURE';
LINE_GATHERDIGITS : TmpStr:='
LINE_GATHERDIGITS';
LINE_GENERATE : TmpStr:='
LINE_GENERATE';
LINE_LINEDEVSTATE : TmpStr:='
LINE_LINEDEVSTATE';
LINE_MONITORDIGITS : TmpStr:='
LINE_MONITORDIGITS';
LINE_MONITORMEDIA : TmpStr:='
LINE_MONITORMEDIA';
LINE_MONITORTONE : TmpStr:='
LINE_MONITORTONE';
LINE_REPLY : TmpStr:='
LINE_REPLY';
LINE_REQUEST : TmpStr:='
LINE_REQUEST';
PHONE_BUTTON : TmpStr:='
PHONE_BUTTON';
PHONE_CLOSE : TmpStr:='
PHONE_CLOSE';
PHONE_DEVSPECIFIC : TmpStr:='
PHONE_DEVSPECIFIC';
PHONE_REPLY : TmpStr:='
PHONE_REPLY';
PHONE_STATE : TmpStr:='
PHONE_STATE';
LINE_CREATE : TmpStr:='
LINE_CREATE';
PHONE_CREATE : TmpStr:='
PHONE_CREATE';
LINE_AGENTSPECIFIC : TmpStr:='
LINE_AGENTSPECIFIC';
LINE_AGENTSTATUS : TmpStr:='
LINE_AGENTSTATUS';
LINE_APPNEWCALL : TmpStr:='
LINE_APPNEWCALL';
LINE_PROXYREQUEST : TmpStr:='
LINE_PROXYREQUEST';
LINE_REMOVE : TmpStr:='
LINE_REMOVE';
PHONE_REMOVE : TmpStr:='
PHONE_REMOVE';
else TmpStr:='
dwMsg unbekannt';
end;
DevTest(TmpStr);
DevTest('
dwParam1: '+IntTostr(dwParam1)+'
| '+'
dwParam2: '+IntTostr(dwParam2)+'
| '+'
dwParam3: '+IntTostr(dwParam3));
(*
Beschreibung für Parameter 1 - 3
================================
LINE_ADDRESSSTATE
=================
dwParam1: The address identifier of the address that changed status.
dwParam2: The address state that changed. Can be one or more of the LINEADDRESSSTATE_ constants.
dwParam3: Unused.
LINE_APPNEWCALL
===============
dwParam1: Identifier of the address on the line on which the call appears. An address identifier is permanently associated with an address; the identifier remains constant across operating system upgrades.
dwParam2: The application's handle to the new call.
dwParam3: The applications privilege to the new call (LINECALLPRIVILEGE_OWNER or LINECALLPRIVILEGE_MONITOR).
LINE_APPNEWCALLHUB
==================
dwParam1: The tracking level on the new hub, as defined by one of the LINECALLHUBTRACKING_ Constants.
dwParam2: Unused.
dwParam3: Unused.
LINE_CALLINFO
=============
dwParam1: The call information item that has changed. Can be one or more of the LINECALLINFOSTATE_ constants.
dwParam2: Unused.
dwParam3: Unused.
LINE_CALLHUBCLOSE
=================
dwParam1: Reserved. Set to 0.
dwParam2: Reserved. Set to 0.
dwParam3: Reserved. Set to 0.
LINE_CALLSTATE
==============
dwParam1
--------
The new call state. This parameter must be one and only one of the following LINECALLSTATE_ constants.
dwParam1 Meaning
LINECALLSTATE_BUSY dwParam2 contains details about the busy mode. This parameter uses one of the LINEBUSYMODE_ constants.
LINECALLSTATE_CONNECTED dwParam2 contains details about the connected mode. This parameter uses one of the LINECONNECTEDMODE_ constants.
LINECALLSTATE_DIALTONE dwParam2 contains details about the dial tone mode. This parameter uses one of the LINEDIALTONEMODE_ constants.
LINECALLSTATE_OFFERING dwParam2 contains details about the connected mode. This parameter uses one of the LINEOFFERINGMODE_ constants.
LINECALLSTATE_SPECIALINFO dwParam2 contains the details about the special information mode. This parameter uses one of the LINESPECIALINFO_ constants.
LINECALLSTATE_DISCONNECTED dwParam2 contains details about the disconnect mode. This parameter uses one of the LINEDISCONNECTMODE_ constants.
dwParam2
--------
Call-state-dependent information. See dwParam1.
Note In circumstances where a delayed response is appropriate, use LINEDISCONNECTMODE_TEMPFAILURE. Where a blacklisted response is appropriate, use LINEDISCONNECT_BLOCKED. For further information, see LINEDISCONNECTMODE_ Constants.
If dwParam1 is LINECALLSTATE_CONFERENCED, dwParam2 contains the hConfCall parameter of the parent call of the conference of which the subject hCall is a member. If the call specified in dwParam2 was not previously considered by the application to be a parent conference call (hConfCall, the application must do so as a result of this message. If the application does not have a handle to the parent call of the conference (because it has previously called lineDeallocateCall on that handle) dwParam2 is set to NULL.
dwParam3
--------
If zero, this parameter indicates that there has been no change in the application's privilege for the call.
If nonzero, it specifies the application's privilege for the call. This occurs in the following situations: (1) The first time that the application is given a handle to this call; (2) When the application is the target of a call handoff (even if the application already was an owner of the call). This parameter uses one of the following LINECALLPRIVILEGE_ constants.
LINE_CLOSE
==========
dwParam1: Unused.
dwParam2: Unused.
dwParam3: Unused.
LINE_CREATE
===========
dwParam1: The hDeviceID of the newly created device.
dwParam2: Unused.
dwParam3: Unused.
LINE_DEVSPECIFIC
================
dwParam1: Device specific.
dwParam2: Device specific.
dwParam3: Device specific.
LINE_DEVSPECIFICEX
==================
dwParam1: Device specific.
dwParam2: Device specific.
dwParam3: Device specific.
LINE_DEVSPECIFICFEATURE
=======================
dwParam1: Device specific.
dwParam2: Device specific.
dwParam3: Device specific.
LINE_GATHERDIGITS
=================
dwParam1: The reason why digit gathering was terminated. This parameter must be one and only one of the LINEGATHERTERM_ constants.
dwParam2: Unused.
dwParam3: The "tick count" (number of milliseconds since Windows started) at which the digit gathering completed. For TAPI versions earlier than 2.0, this parameter is unused.
LINE_GENERATE
=============
dwParam1: The reason why digit or tone generation was terminated. This parameter must be one and only one of the LINEGENERATETERM_ constants.
dwParam2: Unused.
dwParam3: The "tick count" (number of milliseconds since Windows started) at which the digit or tone generation completed. For API versions earlier than 2.0, this parameter is unused.
LINE_LINEDEVSTATE
=================
dwParam1
--------
The line device status item that has changed. The parameter can be one or more of the LINEDEVSTATE_ constants.
dwParam2
--------
The interpretation of this parameter depends on the value of dwParam1. If dwParam1 is LINEDEVSTATE_RINGING, dwParam2 contains the ring mode with which the switch instructs the line to ring. Valid ring modes are numbers in the range one to dwNumRingModes, where dwNumRingModes is a line device capability.
If dwParam1 is LINEDEVSTATE_REINIT, and the message was issued by TAPI as a result of translation of a new API message into a REINIT message, then dwParam2 contains the dwMsg parameter of the original message (for example, LINE_CREATE or LINE_LINEDEVSTATE). If dwParam2 is zero, this indicates that the REINIT message is a "real" REINIT message that requires the application to call lineShutdown at its earliest convenience.
dwParam3
--------
The interpretation of this parameter depends on the value of dwParam1. If dwParam1 is LINEDEVSTATE_RINGING, dwParam3 contains the ring count for this ring event. The ring count starts at zero.
If dwParam1 is LINEDEVSTATE_REINIT, and the message was issued by TAPI as a result of translation of a new API message into a REINIT message, then dwParam3 contains the dwParam1 parameter of the original message (for example, LINEDEVSTATE_TRANSLATECHANGE or some other LINEDEVSTATE_ value, if dwParam2 is LINE_LINEDEVSTATE, or the new device identifier, if dwParam2 is LINE_CREATE).
LINE_MONITORDIGITS
==================
dwParam1: The low-order byte contains the last digit received in a text representation.
dwParam2: The digit mode that was detected. This parameter must be one and only one of the LINEDIGITMODE_ constants.
dwParam3: The "tick count" (number of milliseconds since Windows started) at which the specified digit was detected. For TAPI versions earlier than 2.0, this parameter is unused.
LINE_MONITORMEDIA
=================
dwParam1: The new media type (or mode). This parameter must be one and only one of the LINEMEDIAMODE_ constants.
dwParam2: Unused.
dwParam3: The "tick count" (number of milliseconds since Windows started) at which the specified media was detected. For TAPI versions earlier than 2.0, this parameter is unused.
LINE_MONITORTONE
================
dwParam1: The application-specific dwAppSpecific member of the LINEMONITORTONE structure for the tone that was detected.
dwParam2: Unused.
dwParam3: The "tick count" (number of milliseconds since Windows started) at which the tone was detected. For API versions earlier than 2.0, this parameter is unused.
LINE_REMOVE
===========
dwParam1: Identifier of the line device that was removed.
dwParam2: Reserved. Set to zero.
dwParam3: Reserved. Set to zero.
LINE_REPLY
==========
dwParam1: The request identifier for which this is the reply.
dwParam2: The success or error indication. The application should cast this parameter into a LONG. Zero indicates success; a negative number indicates an error.
dwParam3: Unused.
LINE_REQUEST
============
dwParam1: The request mode of the newly pending request. This parameter uses the LINEREQUESTMODE_ constants.
dwParam2: The conditions for this parameter are, if dwParam1 is set to LINEREQUESTMODE_DROP, dwParam2 contains the hWnd of the application requesting the drop. Otherwise, dwParam2 is unused.
dwParam3: If dwParam1 is set to LINEREQUESTMODE_DROP, the low-order word of dwParam3 contains the wRequestID as specified by the application that requested the drop. Otherwise, dwParam3 is unused.
*)
if dwMsg=LINE_APPNEWCALL
then begin
DevTest('
Neuer Anruf');
// Neue Call-Verbindung hinzufügen
AddCallCon(dwParam2);
end;
if (dwMsg=LINE_REPLY)
and (dwParam2=0)
then begin
DevTest('
Neuer Anruf');
// Neue Call-Verbindung hinzufügen
AddCallCon(dwParam3);
end;
if dwMsg=LINE_CALLSTATE
then begin
case dwParam1
of
LINECALLSTATE_IDLE : TmpStr:='
LINECALLSTATE_IDLE';
LINECALLSTATE_OFFERING : TmpStr:='
LINECALLSTATE_OFFERING';
LINECALLSTATE_ACCEPTED : TmpStr:='
LINECALLSTATE_ACCEPTED';
LINECALLSTATE_DIALTONE : TmpStr:='
LINECALLSTATE_DIALTONE';
LINECALLSTATE_DIALING : TmpStr:='
LINECALLSTATE_DIALING';
LINECALLSTATE_RINGBACK : TmpStr:='
LINECALLSTATE_RINGBACK';
LINECALLSTATE_BUSY : TmpStr:='
LINECALLSTATE_BUSY';
LINECALLSTATE_SPECIALINFO : TmpStr:='
LINECALLSTATE_SPECIALINFO';
LINECALLSTATE_CONNECTED : TmpStr:='
LINECALLSTATE_CONNECTED';
LINECALLSTATE_PROCEEDING : TmpStr:='
LINECALLSTATE_PROCEEDING';
LINECALLSTATE_ONHOLD : TmpStr:='
LINECALLSTATE_ONHOLD';
LINECALLSTATE_CONFERENCED : TmpStr:='
LINECALLSTATE_CONFERENCED';
LINECALLSTATE_ONHOLDPENDCONF : TmpStr:='
LINECALLSTATE_ONHOLDPENDCONF';
LINECALLSTATE_ONHOLDPENDTRANSFER : TmpStr:='
LINECALLSTATE_ONHOLDPENDTRANSFER';
LINECALLSTATE_DISCONNECTED : TmpStr:='
LINECALLSTATE_DISCONNECTED';
LINECALLSTATE_UNKNOWN : TmpStr:='
LINECALLSTATE_UNKNOWN';
else TmpStr:='
dwParam1 unbekannt';
end;
DevTest(TmpStr);
case dwParam1
of
LINECALLSTATE_IDLE : DeleteCallCon(hDevice);
// Element aus der Listen-Kette löschen
LINECALLSTATE_OFFERING : SetCallConItem(hDevice, 0, True);
// Eingehender Ruf
LINECALLSTATE_DIALTONE : SetCallConItem(hDevice, 0, False);
// Ausgehender Ruf
LINECALLSTATE_CONNECTED : SetCallConItem(hDevice, 3, True);
// Ruf angenommen
LINECALLSTATE_DISCONNECTED :
begin
SetCallConItem(hDevice, 3, False);
// Verbindung getrennt
DeleteCallCon(hDevice);
// Element aus der Listen-Kette löschen
end;
LINECALLSTATE_RINGBACK : SetCallConItem(hDevice, 100, 0);
end;
end;
ret:=0;
if dwMsg = LINE_CALLINFO
then begin
//LCI.dwTotalSize:=380;
//ret:=Tapi.lineGetCallInfoW(hDev, @LCI);
// Vorabanfrage wg. neededSize
SetLength(Buffer, SizeOf(TLineCallInfo));
TLineCallInfo(Pointer(Buffer)^).dwTotalSize:=Length(Buffer);
ret:=lineGetCallInfoW(hDevice, @Buffer[0]);
if ret>0
then goto Quit;
// Speicher reservieren
SetLength(Buffer, TLineCallInfo(Pointer(Buffer)^).dwNeededSize);
TLineCallInfo(Pointer(Buffer)^).dwTotalSize:=Length(Buffer);
// Abfrage
ret:=lineGetCallInfoW(hDevice, @Buffer[0]);
(*
TmpStr:='';
case TLineCallInfo(Pointer(Buffer)^).dwBearerMode of
LINEBEARERMODE_VOICE : TmpStr:='LINEBEARERMODE_VOICE';
LINEBEARERMODE_SPEECH : TmpStr:='LINEBEARERMODE_SPEECH';
LINEBEARERMODE_MULTIUSE : TmpStr:='LINEBEARERMODE_MULTIUSE';
LINEBEARERMODE_DATA : TmpStr:='LINEBEARERMODE_DATA';
LINEBEARERMODE_ALTSPEECHDATA : TmpStr:='LINEBEARERMODE_ALTSPEECHDATA';
LINEBEARERMODE_NONCALLSIGNALING : TmpStr:='LINEBEARERMODE_NONCALLSIGNALING';
LINEBEARERMODE_PASSTHROUGH : TmpStr:='LINEBEARERMODE_PASSTHROUGH';
LINEBEARERMODE_RESTRICTEDDATA : TmpStr:='LINEBEARERMODE_RESTRICTEDDATA';
else TmpStr:='dwBearerMode unbekannt';
end;
Form1.Memo1.Lines.Add(TmpStr);
TmpStr:='';
CallState:=TLineCallInfo(Pointer(Buffer)^).dwCallStates;
if CallState and LINEMEDIAMODE_UNKNOWN > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_UNKNOWN'+'|';
if CallState and LINEMEDIAMODE_INTERACTIVEVOICE > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_INTERACTIVEVOICE'+'|';
if CallState and LINEMEDIAMODE_AUTOMATEDVOICE > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_AUTOMATEDVOICE'+'|';
if CallState and LINEMEDIAMODE_DATAMODEM > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_DATAMODEM'+'|';
if CallState and LINEMEDIAMODE_G3FAX > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_G3FAX'+'|';
if CallState and LINEMEDIAMODE_TDD > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_TDD'+'|';
if CallState and LINEMEDIAMODE_G4FAX > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_G4FAX'+'|';
if CallState and LINEMEDIAMODE_DIGITALDATA > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_DIGITALDATA'+'|';
if CallState and LINEMEDIAMODE_TELETEX > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_TELETEX'+'|';
if CallState and LINEMEDIAMODE_VIDEOTEX > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_VIDEOTEX'+'|';
if CallState and LINEMEDIAMODE_TELEX > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_TELEX'+'|';
if CallState and LINEMEDIAMODE_MIXED > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_MIXED'+'|';
if CallState and LINEMEDIAMODE_ADSI > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_ADSI'+'|';
if CallState and LINEMEDIAMODE_VOICEVIEW > 0 then TmpStr:=TmpStr+'LINEMEDIAMODE_VOICEVIEW'+'|';
Delete(TmpStr, Length(TmpStr), 1);
Form1.Memo1.Lines.Add('Status: '+TmpStr);
TmpStr:='';
CallState:=TLineCallInfo(Pointer(Buffer)^).dwCallStates;
if CallState and LINECALLSTATE_ACCEPTED > 0 then TmpStr:=TmpStr+'LINECALLSTATE_ACCEPTED'+'|';
if CallState and LINECALLSTATE_IDLE > 0 then TmpStr:=TmpStr+'LINECALLSTATE_IDLE'+'|';
if CallState and LINECALLSTATE_OFFERING > 0 then TmpStr:=TmpStr+'LINECALLSTATE_OFFERING'+'|';
if CallState and LINECALLSTATE_ACCEPTED > 0 then TmpStr:=TmpStr+'LINECALLSTATE_ACCEPTED'+'|';
if CallState and LINECALLSTATE_DIALTONE > 0 then TmpStr:=TmpStr+'LINECALLSTATE_DIALTONE'+'|';
if CallState and LINECALLSTATE_DIALING > 0 then TmpStr:=TmpStr+'LINECALLSTATE_DIALING'+'|';
if CallState and LINECALLSTATE_RINGBACK > 0 then TmpStr:=TmpStr+'LINECALLSTATE_RINGBACK'+'|';
if CallState and LINECALLSTATE_BUSY > 0 then TmpStr:=TmpStr+'LINECALLSTATE_BUSY'+'|';
if CallState and LINECALLSTATE_SPECIALINFO > 0 then TmpStr:=TmpStr+'LINECALLSTATE_SPECIALINFO'+'|';
if CallState and LINECALLSTATE_CONNECTED > 0 then TmpStr:=TmpStr+'LINECALLSTATE_CONNECTED'+'|';
if CallState and LINECALLSTATE_PROCEEDING > 0 then TmpStr:=TmpStr+'LINECALLSTATE_PROCEEDING'+'|';
if CallState and LINECALLSTATE_ONHOLD > 0 then TmpStr:=TmpStr+'LINECALLSTATE_ONHOLD'+'|';
if CallState and LINECALLSTATE_CONFERENCED > 0 then TmpStr:=TmpStr+'LINECALLSTATE_CONFERENCED'+'|';
if CallState and LINECALLSTATE_ONHOLDPENDCONF > 0 then TmpStr:=TmpStr+'LINECALLSTATE_ONHOLDPENDCONF'+'|';
if CallState and LINECALLSTATE_ONHOLDPENDTRANSFER > 0 then TmpStr:=TmpStr+'LINECALLSTATE_ONHOLDPENDTRANSFER'+'|';
if CallState and LINECALLSTATE_DISCONNECTED > 0 then TmpStr:=TmpStr+'LINECALLSTATE_DISCONNECTED'+'|';
if CallState and LINECALLSTATE_UNKNOWN > 0 then TmpStr:=TmpStr+'LINECALLSTATE_UNKNOWN'+'|';
Delete(TmpStr, Length(TmpStr), 1);
Form1.Memo1.Lines.Add('Status: '+TmpStr);
*)
// Anrufer
Size:=TLineCallInfo(Pointer(Buffer)^).dwCallerIDSize;
Offset:=TLineCallInfo(Pointer(Buffer)^).dwCallerIDOffset;
SetCallConItem(hDevice, 1,
String(PWideChar(@Buffer[Offset])));
if Size>0
then DevTest('
Anrufer: '+PWideChar(@Buffer[Offset]));
// Anruf-Empfänger
Size:=TLineCallInfo(Pointer(Buffer)^).dwCalledIDSize;
Offset:=TLineCallInfo(Pointer(Buffer)^).dwCalledIDOffset;
SetCallConItem(hDevice, 2,
String(PWideChar(@Buffer[Offset])));
if Size>0
then DevTest('
Anruf-Empfänger: '+PWideChar(@Buffer[Offset]));
end;
Quit:
SetLength(Buffer, 0);
if ret<>0
then DevTest(GetTapiErrorMessage(ret));
DevTest('
LineAppCallBack End');
end;
(* ------------------------------ Anrufen ----------------------------------- *)
function TTapi.Call(Num:
String): Boolean;
var ret: Cardinal;
hC: ThCall;
begin
DevTest('
Call Start');
Result:=False;
if TapiPhone.hLine=0
then begin
FLastMessage:='
Kein Tapi-Gerät aktiv.';
Exit;
end;
ret:=lineMakeCallW(TapiPhone.hLine, @hC, PWideChar(Num), 0,
nil);
if ret=0
then Result:=True
else FLastMessage:=IntToStr(ret)+'
: '+GetTapiErrorMessage(ret);
DevTest('
Call End');
end;
(* ---------------------- Komponenten-Registrierung ------------------------- *)
procedure Register;
begin
RegisterComponents('
Matthias', [TTapi]);
end;
end.