adtapi.pas

测试用例

      {Owned components going away}
      if AComponent = FTapiDevice then
        FTapiDevice := nil;
    end;
  end;

  constructor TApdTapiLog.Create(AOwner : TComponent);
  begin
    inherited Create(AOwner);

    {Inits}
    TapiHistoryName := DefTapiHistoryName;
  end;

  destructor TApdTapiLog.Destroy;
  begin
    if Assigned(FTapiDevice) then
      FTapiDevice.TapiLog := nil;
    inherited Destroy;
  end;

  procedure TApdTapiLog.UpdateLog(const Log : TTapiLogCode);
    {-Update the standard log}
  var
    HisFile : TextFile;

  begin
    {Exit if no name specified}
    if FTapiHistoryName = '' then
      Exit;

    { modified for .04 to check for existence of the file first }
    AssignFile(HisFile, FTapiHistoryName);
    if FileExists(FTapiHistoryName) then                               {!!.04}
      Append(HisFile)
    else                                                               {!!.04}
      Rewrite(HisFile);                                                {!!.04}

    {Write the log entry}
    with TapiDevice do begin
      case Log of
        ltapiNone : ;
        ltapiCallStart :
          WriteLn(HisFile, DateTimeToStr(Now), ' : ',  'call started');
        ltapiCallFinish :
          WriteLn(HisFile, DateTimeToStr(Now), ' : ',  'call finished'^M^J);
        ltapiDial :
          WriteLn(HisFile, DateTimeToStr(Now), ' : ',  '  dialing ', Number);
        ltapiAccept :
          WriteLn(HisFile, DateTimeToStr(Now), ' : ',  '  accepting'); 
        ltapiAnswer :
          WriteLn(HisFile, DateTimeToStr(Now), ' : ',  '  answering');
        ltapiConnect :
          WriteLn(HisFile, DateTimeToStr(Now), ' : ',  '  connected');
        ltapiCancel :
          WriteLn(HisFile, DateTimeToStr(Now), ' : ',  '  cancelled');
        ltapiDrop :
          WriteLn(HisFile, DateTimeToStr(Now), ' : ',  '  dropped');
        ltapiBusy:
          WriteLn(HisFile, DateTimeToStr(Now), ' : ',  '  busy');
        ltapiDialFail :
          WriteLn(HisFile, DateTimeToStr(Now), ' : ',  '  dial failed');
        ltapiReceivedDigit :                                                
          WriteLn(HisFile, DateTimeToStr(Now), ' : ',  '  received digit');
      end;
    end;

    Close(HisFile);
    if IOResult <> 0 then ;
  end;

{TApdAbstractTapiStatus}

  procedure TApdAbstractTapiStatus.Notification(AComponent : TComponent;
                                                Operation: TOperation);
  begin
    inherited Notification(AComponent, Operation);

    if Operation = opRemove then begin
      if AComponent = FTapiDevice then
        FTapiDevice := nil;
    end;
  end;

  procedure TApdAbstractTapiStatus.SetPosition(const NewPosition : TPosition);
    {-Pass through position requests}
  begin
    if NewPosition <> FPosition then begin
      FPosition := NewPosition;
      if Assigned(FDisplay) then
        FDisplay.Position := NewPosition;
    end;
  end;

  procedure TApdAbstractTapiStatus.SetCtl3D(const NewCtl3D : Boolean);
    {-Pass through CTL3D property}
  begin
    if NewCtl3D <> FCtl3D then begin
      FCtl3D := NewCtl3D;
      if Assigned(FDisplay) then
        FDisplay.Ctl3D := NewCtl3D;
    end;
  end;

  procedure TApdAbstractTapiStatus.SetVisible(const NewVisible : Boolean);
    {-Pass through the Visible property}
  begin
    if NewVisible <> FVisible then begin
      FVisible := NewVisible;
      if Assigned(FDisplay) then
        FDisplay.Visible := NewVisible;
    end;
  end;

  procedure TApdAbstractTapiStatus.SetCaption(const NewCaption : TCaption);
    {-Pass through the Caption property}                               
  begin                                                                
    if NewCaption <> FCaption then begin                               
      FCaption := NewCaption;                                          
      if Assigned(FDisplay) then                                       
        FDisplay.Caption := NewCaption;                                
    end;                                                               
  end;                                                                 

  procedure TApdAbstractTapiStatus.GetProperties;
    {-Get the properties from the status form}
  begin
    if Assigned(FDisplay) then begin
      Position := FDisplay.Position;
      Ctl3D    := FDisplay.Ctl3D;
      Visible  := FDisplay.Visible;
      Caption  := FDisplay.Caption;                                    
    end;
  end;

  constructor TApdAbstractTapiStatus.Create(AOwner : TComponent);
    {-Create the status form}
  begin
    inherited Create(AOwner);
    Caption := 'Call Progress';                                        
    CreateDisplay;
    GetProperties;
  end;

  destructor TApdAbstractTapiStatus.Destroy;
    {-Get rid of the status form}
  begin
    DestroyDisplay;
    if Assigned(FTapiDevice) then
      FTapiDevice.StatusDisplay := nil;
    inherited Destroy;
  end;

  procedure TApdAbstractTapiStatus.Show;
    {-Show the status form}
  begin
    if Assigned(FDisplay) then
      FDisplay.Show;
  end;

{TAPI callback}

{$IFDEF TapiDebug}
const
  Digits : array[0..$F] of Char = '0123456789ABCDEF';
type
  Long =
    record
      LowWord, HighWord : Word;
    end;

  function HexW(W : Word) : ShortString;
    {-Return hex string for word}
  begin
    HexW[0] := #4;
    HexW[1] := Digits[hi(W) shr 4];
    HexW[2] := Digits[hi(W) and $F];
    HexW[3] := Digits[lo(W) shr 4];
    HexW[4] := Digits[lo(W) and $F];
  end;

  function HexL(L : LongInt) : ShortString;
    {-Return hex string for LongInt}
  begin
    with Long(L) do
      HexL := HexW(HighWord)+HexW(LowWord);
  end;
{$ENDIF}

  procedure GenCallback(Device, Message, Instance, Param1, Param2, Param3 : LongInt);
    stdcall;
  var
    TP : TApdTapiDevice absolute Instance;
  begin
    {$IFDEF TapiDebug}
    WriteLn(Dbg, 'Callback. Device: ', HexL(Device), '  Message: ', HexL(Message),
      ' P1,P2,P3: ', HexL(Param1), ' ', HexL(Param2), ' ', HexL(Param3));
    case Message of
      Line_AddressState       : WriteLn(Dbg,'  Line_AddressState message');
      Line_CallInfo           : WriteLn(Dbg,'  Line_CallInfo message');
      Line_Callstate          : WriteLn(Dbg,'  Line_Callstate message');
      Line_Close              : WriteLn(Dbg,'  Line_Close message');
      Line_DevSpecific        : WriteLn(Dbg,'  Line_DevSpecific message');
      Line_DevSpecificFeature : WriteLn(Dbg,'  Line_DevSpecificFeature message');
      Line_GatherDigits       : WriteLn(Dbg,'  Line_GatherDigits message');
      Line_Generate           : WriteLn(Dbg,'  Line_Generate message');
      Line_LineDevState       : WriteLn(Dbg,'  Line_LineDevState message');
      Line_MonitorDigits      : WriteLn(Dbg,'  Line_MonitorDigits message');
      Line_MonitorMedia       : WriteLn(Dbg,'  Line_MonitorMedia message');
      Line_MonitorTone        : WriteLn(Dbg,'  Line_MonitorTone message');
      Line_Reply              : WriteLn(Dbg,'  Line_Reply message');
      Line_Request            : WriteLn(Dbg,'  Line_Request message');
      Phone_Button            : WriteLn(Dbg,'  Phone_Button message');
      Phone_Close             : WriteLn(Dbg,'  Phone_Close message');
      Phone_DevSpecific       : WriteLn(Dbg,'  Phone_DevSpecific message');
      Phone_Reply             : WriteLn(Dbg,'  Phone_Reply message');
      Phone_State             : WriteLn(Dbg,'  Phone_State message');
      Line_Create             : WriteLn(Dbg,'  Line_Create message');
      Line_Remove             : WriteLn(Dbg,'  Line_Remove message');    {!!.02}
      Phone_Create            : WriteLn(Dbg,'  Phone_Create message');
    end;
    WriteLn(Dbg, '--TapiStatusMsg=', TP.TapiStatusMsg(                 
      Message, Param1, Param2));                                       
    {$ENDIF}

    if Message = Line_Create then
      PostMessage(HWND_BROADCAST, apw_TapiEventMessage, etTapiLineCreate, Param1);

    if TP = nil then
      Exit;

    with TP do try
      case Message of
        Line_Reply         : DoLineReply(Device, Param1, Param2, Param3);
        Line_CallInfo      : DoLineCallInfo(Device, Param1, Param2, Param3);
        Line_CallState     : DoLineCallState(Device, Param1, Param2, Param3);
        Line_Close         : DoLineClose(Device, Param1, Param2, Param3);
        Line_LineDevState  : DoLineDevState(Device, Param1, Param2, Param3);
        Line_Create        : DoLineCreate(Device, Param1, Param2, Param3);
        Line_MonitorDigits : DoLineMonitorDigits(Device, Param1, Param2, Param3);
        Line_Generate      : DoLineGenerate(Device, Param1, Param2, Param3);
        Line_MonitorMedia  : DoLineMonitorMedia(Device, Param1, Param2, Param3);
        Line_MonitorTone   : DoLineMonitorTone(Device, Param1, Param2, Param3);
        Line_Request       : DoLineRequest(Device, Param1, Param2, Param3);
      end;
    except
      Application.HandleException(nil);
    end;
  end;

{TApdCustomTapiDevice}

  function SearchStatusDisplay(const C : TComponent) : TApdAbstractTapiStatus;
    {-Search for a status display in the same form as TComponent}

    function FindStatusDisplay(const C : TComponent) : TApdAbstractTapiStatus;
    var
      I  : Integer;
    begin
      Result := nil;
      if not Assigned(C) then
        Exit;

      {Look through all of the owned components}
      for I := 0 to C.ComponentCount-1 do begin
        if C.Components[I] is TApdAbstractTapiStatus then begin
          {...and it's not assigned}
          if not Assigned(
            TApdAbstractTapiStatus(C.Components[I]).FTapiDevice) then begin
            Result := TApdAbstractTapiStatus(C.Components[I]);
            Exit;
          end;
        end;

        {If this isn't one, see if it owns other components}
        Result := FindStatusDisplay(C.Components[I]);
      end;
    end;

  begin
    {Search the entire form}
    Result := FindStatusDisplay(C);
  end;

  function SearchTapiLog(const C : TComponent) : TApdTapiLog;
    {-Search for a tapi log component on the same form as TComponent}

    function FindTapiLog(const C : TComponent) : TApdTapiLog;
    var
      I  : Integer;
    begin
      Result := nil;
      if not Assigned(C) then
        Exit;

      {Look through all of the owned components}
      for I := 0 to C.ComponentCount-1 do begin
        if C.Components[I] is TApdTapiLog then begin
          {...and it's not assigned}
          if not Assigned(TApdTapiLog(C.Components[I]).FTapiDevice) then begin
            Result := TApdTapiLog(C.Components[I]);
            Exit;
          end;
        end;

        {If this isn't one, see if it owns other components}
        Result := FindTapiLog(C.Components[I]);
      end;
    end;

  begin
    {Search the entire form}
    Result := FindTapiLog(C);
  end;

  procedure TApdCustomTapiDevice.DoLineReply(Device, P1, P2, P3 : LongInt);
  begin
    if (RequestedId = P1) then begin
      ReplyReceived := True;
      AsyncReply := P2;
    end;
  end;

  procedure TApdCustomTapiDevice.DoLineCallInfo(Device, P1, P2, P3 : LongInt);
  begin
    { Update the CallInfo record }
    UpdateCallInfo(Device);

    if ((P1 and LineCallInfoState_CallerID) <> 0) then begin
      {Generate Caller ID event}
      TapiCallerID(Trim(CallerID), Trim(CallerIDName));
    end;

    { generate the OnTapiStatus event }
    TapiStatus(False, False, Device, Line_CallInfo, P1, P2, P3);         {!!.04}    
  end;

  procedure TApdCustomTapiDevice.DoLineCallState(Device, P1, P2, P3 : LongInt);
  const
    OurMediaModes : array[Boolean] of DWORD = ((LINEMEDIAMODE_UNKNOWN or
      LINEMEDIAMODE_DATAMODEM or LINEMEDIAMODE_G3FAX),
      (LINEMEDIAMODE_UNKNOWN or LINEMEDIAMODE_DATAMODEM or
      LINEMEDIAMODE_AUTOMATEDVOICE or LINEMEDIAMODE_G3FAX));
  begin
    {$IFDEF TapiDebug}
    if (Device <> CallHandle) and (P1 <> LineCallState_Idle) then
      WriteLn(Dbg, 'Line_CallState: Unknown Device ID ', HexL(Device));
    {$ENDIF}

    CallState := P1;
    CallStateReceived := True;

    case P1 of
      LineCallState_Dialtone :
        begin
          TapiStatus(True, False, Device, Line_CallState, P1, P2, P3);
        end;

      LineCallState_Dialing :
        begin
          TapiStatus(False, False, Device, Line_CallState, P1, P2, P3);
        end;