icall.pas

该控件为CAPI 2.0驱动的ISDN控制器提供呼叫方ID功能的控件。它提供两个方法：OnRing和OnEndRing来截获呼叫的开始和结束。

{*******************************************************}
{                                                       }
{       Icall Definitions unit                          }
{       Identify Calls v. 1.0.3                         }
{                                                       }
{       Freeware                                        }
{                                                       }
{       Developer: Stratos Christodoulou                }
{                                                       }
{       Version 1.0.2                                   }
{          Added comments                               }
{       Version 1.0.3                                   }
{          A bug fixed at Msn stringlist (component     }
{          couldn't set Msn.Count = 0                   }
{*******************************************************}

unit iCall;

interface
uses windows,classes,defs,sysutils,extctrls;

Type
//Fires up when a  line is ringing
  TRingEvent = procedure (Caller ,Receiver: string) of object;
//Fires up when a  ringing is stoping
  TEndRingEvent = procedure(const totalSecTime:integer;Reason:string) of object;

//Thread object to catch the events on the isdn controller
  CapiThread = class(TThread)
  private
    { Private declarations }
    procedure alfa;
  protected
    procedure Execute; override;
  end;

  TIcall = class (TComponent)
    private
      capiBuffer:DWORD;
      Fcontrollers:byte;
      controler:DWORD;
      fIsError:Boolean;
      fApplID:DWORD;
      fCapiInstalled:Boolean;
      Fagnostos:String;
      Ftimer:TTImer;
      Factive:boolean;
      Fprofile:TProfileStruct;
      Fversion:String;
      Fmanufacturer:String;
      Fserial:string;
      Flistening:Boolean;
      FonRing:TRingEvent;
      FonEndRing:TEndRingEvent;
      FMsn: TStrings;
      FPLCI:Dword;
      FcapiThread:CapiThread;
      Fstart:DWORD;
      Fstop:Dword;
      procedure SetPrivateCallText(Text:string);
      procedure SetActive(Activate:Boolean);
      procedure CheckCalls(Sender: TObject);
      procedure SetMsn(Value : TStrings);
    public
      { Public declarations }
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      Function GetProfile:TProfileStruct;
      property ApplId:DWORD read FApplID;
      property Profile:TProfileStruct read Fprofile;
      Property Controllers:byte read Fcontrollers;
      property version:string read Fversion;
      property Manufacturer:string read Fmanufacturer;
      property SerialNumber:string read Fserial;
      property Active:boolean read Factive write SetActive;
      property Listening:boolean read Flistening;
    Published
      property CapiInstalled: boolean read FCapiInstalled;
      property PrivateCallText: String read Fagnostos write SetPrivateCallText;
      property OnRing: TRingEvent read FOnRing write FOnRing;
      property OnEndRing:TendRingEvent read FonEndRing write FonEndRing;
      property Msn : TStrings read FMsn write SetMsn;
  end;

  procedure Register;
  var
    apid:DWORD;
    timetocheck:boolean=false;

implementation

procedure Capithread.alfa;
begin
  timetocheck:=true;
end;

procedure CapiThread.Execute;
begin
  freeonTerminate:=true;
  repeat
    if CAPI_WAIT_FOR_SIGNAL(apid)=0 then
      synchronize(alfa);
  until terminated;
end;

procedure Ticall.SetActive(Activate:Boolean);
var
  L_REQ:TListen_REQ;
begin
  Flistening:=false;
  if fIsError then
    exit;
  if (Activate=Factive) or (fCapiInstalled=false) then
    exit;
  with L_REQ do
  begin
    TotalLength:=sizeof(TListen_REQ);
    ApplID:=fApplID;
    Command:=$5;
    SubCommand:=$80;
    MessageNumber:=1;
    Controller:=controler;
    infoMask:=$0;
    CIPMask:=1;
    CIPMASK2:=0;
    CallingPartyNumber:=0;
    CalledPartyNumber:=0;
  end;
  if CAPI_PUT_MESSAGE(fApplId, @L_REQ) =SUCCESS then
  begin
    Fcapithread.Resume;
    Factive:=activate;
  end
  else
    releaseCapi(FapplID);
    Ftimer.Enabled:=Factive;
end;

procedure TIcall.SetPrivateCallText;
Begin
  if text<>Fagnostos then
    Fagnostos:=text;
end;

Constructor TIcall.Create;
var
  ver:Tversion;
begin
  inherited create(Aowner);
  FMsn := TStringList.Create;
  TstringList(FMsn).Sorted := True;
  controler:=0;
  if CAPI_INSTALLED<>SUCCESS then
    fCapiInstalled:=false
  else
    fCapiInstalled:=True;
  if not fIsError then
  begin
    Fcontrollers:=GetActivesControllers;
    if Fcontrollers>0 then
    begin
      controler:=1;
      Fprofile:=getProfile;
    end
    else
    begin
      controler:=0;
      fIsError:=true;
    end;
  end;
  ver:=GetVersion;
  if ver.CAPIMajor<>0 then
  begin
    fversion:=inttostr(ver.CAPIMajor)+'.'+
    inttostr(ver.CAPIMinor)+'.'+
    inttostr(ver.ManufacturerMajor)+'.'+
    inttostr(ver.ManufacturerMinor);
  end;
  Fmanufacturer:=GetManufacturer;
  Fserial:=GetSerial;
  if componentstate <>[csDesigning] then
  begin
  if fCapiInstalled then
    FApplId:=registerCapi;
  If FapplID=0 then
  begin
    fIsError:=true;
    MessageBox(0,'Can''''t install communication with Capi device!','塑栾