tapidial.pas

Basic Marketing stock Program

unit TapiDial;
{TTapiDial is simple dialing component, which implements dialing
through TAPI interface, instead of writing to COM ports directly.

This component is based mostly on TAPI Test by Davide Moretti
<[e-mail]>. The reason I'm going through TAPI is that I
wrote a dialing component, TTelephon, not so long ago, and it
sometimes works, and sometimes doesn't, the reason for that is,
I assume, in the new way of accessing COM ports in win95/win32
enviroment, and writing to port is done by API function WriteFile, or
Delphi FileWrite,(no WriteComm anymore), well those sometimes do
what they are supposed to,and sometimes not.If anyone knows the solution
to that please e-mail me. [e-mail]

Anyway, I wrote this little component to finish my Adress application,and
it is freeware, and you can do with the code whatever you please.

It has 4 "customazible" properties:
CallDialog--> Win95(standard TAPI call dilog)
          --> None (no dialog, just a MessageBox enabling you to hangup)
DialTone--> (enable/disable dial tone detection)
DialMethod-->(Tone/Pulse)
StatusWindow-->(enable/disable StatusWindow which displays current
                line and dialing state in a small window)
And there is, of course TelephonNo--> number to dial

It needs TapiH.pas that contains some TAPI declarations, required
by component

Enjoy it

Mihaela Mihaljevich
[e-mail] }

interface

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

type
  TCallDialog=(None,Win95);
  TDialTone=Boolean;
  TStatusWindow=Boolean;
  TDialMethod=(Tone,Pulse);

  TTapiDial = class(TComponent)
  private
    { Private declarations }
    frmStatWindow : TForm;
    lbxStatWindow : TListBox;
    FTelephonNo : string;
    FCallDialog:TCallDialog;
    FDialTone:TDialTone;
    FDialMethod:TDialMethod;
    FStatusWindow:TStatusWindow;
    lineApp: THLineApp;
    line: THLine;
    call: THCall;
    CallParams: TlineCallParams;
    procedure TerminateTapi;
    procedure InitializeTapi;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Dial;
    procedure HangUp;
    procedure SetCallDialog(NewCallDialog:TCallDialog);
    procedure SetDialTone(NewDialTone:TDialTone);
    procedure SetDialMethod(NewDialMethod:TDialMethod);
    procedure SetStatusWindow(NewStatusWindow:TStatusWindow);
  published
    { Published declarations }
    property TelephonNo: String read FTelephonNo write FTelephonNo;
    property CallDialog:TCallDialog read FCallDialog write SetCallDialog;
    property DialTone:TDialTone read FDialTone write SetDialTone;
    property DialMethod:TDialMethod read FDialMethod write SetDialMethod;
    property StatusWindow:TStatusWindow read FStatusWindow write SetStatusWindow;
  end;

  procedure CreateStatusWindow;
  procedure WriteStatus(Text:string);
  procedure DestroyStatusWindow;
 var
    buf:array[0..1023] of char;
    callinfo: TLineCallInfo absolute buf;
    LineSt: string;
    StatusWindowCreated:Boolean;
    frmStatus:TForm;
    lbxStatus:TListBox;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TTapiDial]);
end;

//Creating invisible form
procedure CreateStatusWindow;
begin
//Kreiranje forme za StatusDialog
   if not StatusWindowCreated then begin
      frmStatus := TForm.Create(Application);
      StatusWindowCreated:=True;
      with frmStatus do begin
          Visible := False;
          Caption := 'Dial Stauts';
          FormStyle := fsStayOnTop;
          BorderStyle := bsSizeable;
          BorderIcons := [];
          Width := 230;
          Height:=100;
          Left:=527;
          Top:=419;
          VertScrollBar.Visible:=True;
      end;
      lbxStatus := TListBox.Create(frmStatus);
      with lbxStatus do begin
        begin
          Parent := frmStatus;
          Align := alClient;
          Sorted := False;
          Font.Name := 'MS Sans Serif';
          Font.Size := 8;
        end;
      end;
   end//if not StatusWindowCreated
else StatusWindowCreated:=False;
end;

procedure DestroyStatusWindow;
begin
   frmStatus.Release;
   StatusWindowCreated:=False;
end;

procedure WriteStatus(Text:string);
begin
   Text:='-> '+Text;
   //We don't wanna' mess with unallocated memory
   if not StatusWindowCreated then
      Exit
   else if StatusWindowCreated then  begin
      lbxStatus.Items.Add(Text);
      lbxStatus.ItemIndex := lbxStatus.Items.Count-1;
   end;
end;

procedure lineCallback(hDevice, dwMsg, dwCallbackInstance,
		dwParam1, dwParam2, dwParam3: LongInt);
		stdcall;
var
   s: string;
   hCall: THCall;
begin
if dwMsg = LINE_REPLY then { result of LineMakeCall }
   if dwParam2 < 0 then begin
      LineSt:='Reply error';
      WriteStatus(LineSt);
   end
   else begin
      LineSt:='LINE_REPLY ok';
      WriteStatus(LineSt);
   end
   else if dwMsg = LINE_CALLSTATE then begin
   { change in line state }
      hCall := THCall(hDevice);
      case dwParam1 of
         LINECALLSTATE_IDLE://call finished
            if hcall <> 0 then begin
               lineDeallocateCall(hCall);//deallocating call
               LineSt:='Idle - call deallocated';
               WriteStatus(LineSt);
            end;
         LINECALLSTATE_CONNECTED:{ Service 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);
               LineSt:=s;
               WriteStatus(LineSt);
            end;
         LINECALLSTATE_PROCEEDING:
         begin
            LineSt:='Proceeding';
            WriteStatus(LineSt);
         end;
         LINECALLSTATE_DIALING:
         begin
            LineSt:='Dialing';
            WriteStatus(LineSt);
         end;
         LINECALLSTATE_DISCONNECTED:
         begin
            s := 'Disconnected: ';
            if dwParam2 = LINEDISCONNECTMODE_NORMAL then
               s := s + 'normal'
            else if dwParam2 = LINEDISCONNECTMODE_BUSY then
               s := s + 'busy';
            LineSt:=s;
            WriteStatus(LineSt);
         end;
         LINECALLSTATE_BUSY:
         begin
            LineSt:='Busy';
            WriteStatus(LineSt);
         end;
      end;
   end;
end;//End--> lineCallBack

procedure TTapiDial.InitializeTapi;
var
   nDevs, tapiVersion: Longint;
   extid: TLineExtensionID;
   Greska:Boolean;
begin
   Greska:=False;
   LineSt:='Initializing TAPI';
   WriteStatus(LineSt);
   FillChar(CallParams, sizeof(CallParams), 0);
   with CallParams do begin
      dwTotalSize := sizeof(CallParams);
      dwBearerMode := LINEBEARERMODE_VOICE;
      if FCallDialog = Win95 then //Use Win95 dialog
         dwMediaMode := LINEMEDIAMODE_INTERACTIVEVOICE
      else if FCallDialog = None then begin//No Win95 dialog
         dwMediaMode := LINEMEDIAMODE_DATAMODEM;
      end;
   end;
   if lineInitialize(lineApp, HInstance,@lineCallback,nil, nDevs)<0 then begin
      lineApp := 0;
      Greska:=True;
   end
   else if nDevs = 0 then begin
      lineShutDown(lineApp);    //No TAPI devices
      lineApp := 0;
      Greska:=True;
      LineSt:='No TAPI devices';
      WriteStatus(LineSt);
   end
   else if lineNegotiateAPIVersion(lineApp, 0, $00010000, $10000000,
   tapiVersion, extid) < 0 then begin
      lineShutDown(lineApp);
      lineApp := 0;
      Greska:=True;
      LineSt:='Error in lineNegotiateAPIVersion';
      WriteStatus(LineSt);
   end
   else if lineOpen(lineApp, LINEMAPPER, line, tapiVersion, 0, 0,
           LINECALLPRIVILEGE_NONE, 0, CallParams) < 0 then begin
      lineShutDown(lineApp);
      lineApp := 0;
      line := 0;
      Greska:=True;
      LineSt:='Error in LineOpen';
      WriteStatus(LineSt);
   end;
   if line = 0 then  begin
      LineSt:='Error!!';
      Greska:=True;
      WriteStatus(LineSt);
   end;
   if not Greska then begin
      LineSt:='TAPI successfully initialized';
      WriteStatus(LineSt);
   end;
end;//InitializeTapi

constructor TTapiDial.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   FTelephonNo:='9865';
   FCallDialog:=None;
   FDialTone:=False;
   FDialMethod:=Tone;
   CreateStatusWindow;
   FStatusWindow:=True;//To make the form Visible
   StatusWindowCreated:=True;
   InitializeTapi;
end;//Kraj od Create

procedure TTapiDial.TerminateTapi;
begin
   { Terminate TAPI }
   if line <> 0 then
      lineClose(line);
   if lineApp <> 0 then
      lineShutDown(lineApp);
   LineSt:='TAPI terminated';
   WriteStatus(LineSt);
end;

destructor TTapiDial.Destroy;
begin
   FStatusWindow:=False;
   StatusWindowCreated:=False;
   TerminateTapi;
   inherited Destroy;
end;

procedure TTapiDial.Dial;
var
   c: array[0..30] of char;
   B:integer;
begin
   if Length(FTelephonNo) > 0 then begin
      StrPCopy(c, FTelephonNo);
      if lineMakeCall(line, call, c, 0, CallParams) < 0 then  begin
         LineSt:='Error in lineMakeCall';
         WriteStatus(LineSt);
      end;
      //if calling with LINEMEDIAMODE_DATAMODEM, must show HangUp dialog
      if CallDialog=None then begin
         //Not gonna' show HangUp dialog if error occured
         if LineSt<>'Error in lineMakeCall' then begin
            B:= Application.MessageBox(PChar('Hangup?')
                        ,PChar('Talking to ' + FTelephonNo), mb_OK);
            if B= IDOK then HangUp;
         end;
      end;//if CallDialog=None
      //if error for any dialog selection
      if LineSt='Error in lineMakeCall' then begin
         if MessageDlg('Error during dialing!,Reinitializing TAPI',mtCustom,
                       [mbOK],0)=mrOK then begin
            TerminateTapi;
            InitializeTapi;
            Exit;
         end;

      end;

   end;//if Length(FTelephonNo) > 0
end; //Dial


procedure TTapiDial.HangUp;
begin
   if LineDrop(call, nil, 0) < 0 then begin
      LineSt:='Error in lineDrop';
      WriteStatus(LineSt);
   end
   else begin
      LineSt:='Line Dropped';
      WriteStatus(LineSt);
   end;
end;

procedure TTapiDial.SetCallDialog(NewCallDialog:TCallDialog);
var
   x:string;
begin
   if NewCallDialog <> FCallDialog then begin
      FCallDialog := NewCallDialog;
      case NewCallDialog of
         Win95: x:='Win95';
         None:  x:='None';
      end;
      LineSt:='Call dialog set to: ' + x;
      WriteStatus(LineSt);
      TerminateTapi;
      InitializeTapi;
   end;
end;

procedure TTapiDial.SetDialTone(NewDialTone:TDialTone);
begin
   if NewDialTone <> FDialTone then begin
      if FDialTone=False then begin// NewDialTone=True
         FTelephonNo:='W'+FTelephonNo;
         LineSt:='DialTone detection set';
         WriteStatus(LineSt);
      end
      else if FDialTone=True then begin//NewDialTone=False
         FTelephonNo:=Copy(FTelephonNo,2,length(FTelephonNo)-1);
         LineSt:='DialTone detection cleared';
         WriteStatus(LineSt);
      end;
      FDialTone := NewDialTone;
   end;
end;

procedure TTapiDial.SetDialMethod(NewDialMethod:TDialMethod);
begin
   if NewDialMethod <> FDialMethod then begin
      if (FTelephonNo[1]<>'T') or (FTelephonNo[1]<>'P') then
         FTelephonNo:=' ' + FTelephonNo;//inserting emplty string

      if FDialMethod=Tone then begin// NewDialMethod=Pulse
         FTelephonNo[1]:='P';
         LineSt:='Dialing changed to Pulse';
         WriteStatus(LineSt);
      end

      else if FDialMethod=Pulse then begin//NewDialMethod=Tone
         FTelephonNo[1]:='T';
         LineSt:='Dialing changed to Tone';
         WriteStatus(LineSt);
      end;

      FDialMethod := NewDialMethod;
   end;
end;

procedure TTapiDial.SetStatusWindow(NewStatusWindow:TStatusWindow);
begin
  if NewStatusWindow <> FStatusWindow then begin
     FStatusWindow := NewStatusWindow;
     //Was True,Is False
     if FStatusWindow=False then begin
        if StatusWindowCreated then DestroyStatusWindow;
     end
     else if FStatusWindow = True then begin
        //frmStatus.Visible:=True;
        //StatusWindowCreated:=True;
        if not (StatusWindowCreated) and
               (not (csDesigning in ComponentState))then begin
           CreateStatusWindow;
           frmStatus.Visible:=True;
        end;
     end;
   end;
end;

end.