adtapi.pas

测试用例

              {$IFDEF TapiDebug}
              WriteLn(Dbg, 'Error from lineClose');
              {$ENDIF}
              Break;
            end;
          until lReturn = Success;
        end;

        CallHandle := 0;
        LineHandle := 0;
        FOpen := False;
        Connected := False;
        TapiInUse := False;

        { Fire port close event if appropriate }
        if CloseEventPending then
          {TapiPortClose;}                                             
          PostMessage(FHandle, apw_TapiEventMessage, etTapiPortClose, 0);

        TapiLogging(ltapiDrop);

        {$IFDEF TapiDebug}
        WriteLn(Dbg, 'Hangup Completed: ', GetTickCount);
        {$ENDIF}

      finally
        { Finalize call, or set up for redial }
        FinalRetry := True;

        if AbortRetries then
          RetryPending := False;
        if RetryPending then begin
          if (FAttempt < FMaxAttempts) then begin
            CreateDialTimer;
            FinalRetry := False;
          end else begin
            RetryPending := False;
          end;
        end;

        if FinalRetry and not PassThruMode then begin
          { Get rid of status display }
          TapiStatus(False, True, 0, 0, 0, 0, 0);
          TapiLogging(ltapiCallFinish);
          { Log failure and fire OnTapiFail if applicable }
          if Failure then begin
            TapiLogging(ltapiDialFail);
            PostMessage(FHandle, apw_TapiEventMessage, etTapiFail, 0); 
          end;
        end;
        StoppingCall := False;
        TapiInUse := False;
      end;
    end else begin
      { Finalize call, or set up for redial }
      FinalRetry := True;

      if AbortRetries then
        RetryPending := False;

      if RetryPending then begin
        if (FAttempt < FMaxAttempts) then begin
          CreateDialTimer;
          FinalRetry := False;
        end else begin
          RetryPending := False;
        end;
      end;

      if TapiHasOpened then                                          
        if FinalRetry and not PassThruMode then begin
          { Get rid of status display }
          TapiStatus(False, True, 0, 0, 0, 0, 0);
          TapiLogging(ltapiCallFinish);
          { Log failure and fire OnTapiFail if applicable }
          if Failure then begin
            TapiLogging(ltapiDialFail);
            PostMessage(FHandle, apw_TapiEventMessage, etTapiFail, 0);
          end;
        end;

      StoppingCall := False;
      TapiInUse := False;

      CallHandle := 0;
      LineHandle := 0;
      FOpen := False;
      Connected := False;
      TapiFailFired := False;
    end;
  end;

  procedure TApdCustomTapiDevice.UpdateCallInfo(Device : LongInt);
  begin
    {We can update callstate properties, first get rid of old...}
    if Assigned(FCallInfo) then begin
      FreeMem(FCallInfo, FCallInfo^.TotalSize);
      FCallInfo := nil;
    end;
    {...then get the new call information}
    tuLineGetCallInfoDyn(Device, FCallInfo);
  end;

  function TApdCustomTapiDevice.WaitForCallState(DesiredCallState : LongInt) : LongInt;
  var
    TimeStart : DWORD;
  begin
    if StateWait then begin
      Result := WaitErr_WaitAborted;
      Exit;
    end;
    CallStateReceived := False;
    TimeStart := GetTickCount;
    StateWait := True;
    try
      while (DesiredCallState = LineCallState_Any) or
            (CallState <> DesiredCallState) do begin
        Application.ProcessMessages;
        if (DesiredCallState = LineCallState_Any) and CallStateReceived then
          Break;
        if not TapiInUse then begin
          Result := WaitErr_WaitAborted;
          Exit;
        end;
        if (GetTickCount - TimeStart) > WaitTimeout then begin
          Result := WaitErr_WaitTimedout;
          Exit;
        end;
      end;
    finally
      StateWait := False;
    end;
    Result := Success;
  end;

  function TApdCustomTapiDevice.WaitForReply(ID : LongInt) : LongInt;
  var
    TimeStart : DWORD;                                                 
  begin
    if ReplyWait then begin
      Result := WaitErr_WaitAborted;
      Exit;
    end;
    TimeStart := GetTickCount;                                         
    ReplyWait := True;
    try
      if (ID > Success) then begin
        ReplyReceived := False;
        RequestedID := ID;
        AsyncReply := LineErr_OperationFailed;
        while not ReplyReceived do begin
          Application.ProcessMessages;
          if (not TapiInUse) then begin
            Result := WaitErr_WaitAborted;
            Exit;
          end;
          if (GetTickCount - TimeStart) > WaitTimeout then begin       
            Result := WaitErr_WaitTimedout;                            
            Exit;                                                      
          end;                                                         
        end;
        Result := AsyncReply;
        Exit;
      end;
    finally
      ReplyWait := False;
    end;
    Result := ID;
  end;

  procedure TApdCustomTapiDevice.TapiDialTimer(Sender : TObject);
    {-Simulate Tapi status calls for dial timing}

    procedure KillDialTimer;
    begin
      if Assigned(DialTimer) then begin
        DialTimer.Free;
        DialTimer := nil;
      end;
    end;

  begin
    {Assume one second went by...}
    Dec(FDialTime);

    {Generate an appropriate status event}
    case TapiState of
      tsIdle :
        if FDialTime <= 0 then begin
          {Redial...}
          KillDialTimer;
          Inc(FAttempt);
          DialPrim(False);
        end else
          {Show countdown}
          if RetryPending then
            TapiStatus(False, False, 0, Line_APDSpecific,
              APDSpecific_RetryWait, 0, 0)
          else
            KillDialTimer;
      else
        KillDialTimer;
    end;
  end;

  procedure TApdCustomTapiDevice.SetEnableVoice(Value: Boolean);
  begin
    FEnableVoice := Value;
    if FEnableVoice and (SelectedDevice <> '') then
        CheckVoiceCapable;
  end;

  procedure TApdCustomTapiDevice.CheckVoiceCapable;
  var
    Count      : DWord;
    LineApp    : TLineApp;
    LineExt    : TLineExtensionID;
    ApiVersion : LongInt;
    LineCaps   : PLineDevCaps;
  begin
    {Does the device support AutomatedVoice?}
    try
      {Initialize a TAPI line}
      CheckException(Self, tuLineInitialize(LineApp,
                                    hInstance,
                                    GenCallback,
                                    '',
                                    Count));

      {Negotiate the API version to use for this device}
      if tuLineNegotiateApiVersion(LineApp, GetSelectedLine,
        TapiHighVer, TapiHighVer, ApiVersion, LineExt) = 0 then begin

        {Get the device capabilities}
        CheckException(Self, tuLineGetDevCapsDyn(LineApp,
          GetSelectedLine, ApiVersion, 0, LineCaps));
        try
          if (LineCaps^.MediaModes and LINEMEDIAMODE_AUTOMATEDVOICE) = 0 then begin
            FEnableVoice := False;
            {raise exception}
            raise ETapiVoiceNotSupported.Create(ecTapiVoiceNotSupported, True);
          end else
            FEnableVoice := True;
        finally
          {Free the buffer allocated by LineGetDevCapsDyn}
          FreeMem(LineCaps, LineCaps^.TotalSize);
        end;
      end;
    except
      FEnableVoice := False;
      raise ETapiVoiceNotSupported.Create(ecTapiVoiceNotSupported, True);
    end;
     {Shutdown this line}
    tuLineShutdown(LineApp);
  end;

  procedure TApdCustomTapiDevice.Notification(AComponent : TComponent;
                                              Operation : TOperation);
    {-Handle new/deleted components}
  begin
    inherited Notification(AComponent, Operation);

    if Operation = opRemove then begin
      {Owned components going away}
      if AComponent = FComPort then
        ComPort := nil;
      if AComponent = FStatusDisplay then
        StatusDisplay := nil;
      if AComponent = FTapiLog then
        TapiLog := nil;
    end else if Operation = opInsert then begin
      {Check for new comport}
      if AComponent is TApdCustomComPort then begin
        if not Assigned(FComPort) then
          ComPort := TApdCustomComPort(AComponent);

        {Force its TapiMode to True, AutoOpen and Open to False}
        if ComPort.TapiMode = tmAuto then begin
          ComPort.TapiMode := tmOn;
          ComPort.AutoOpen := False;
          ComPort.Open := False;
        end;
      end;

      {Check for new status component}
      if AComponent is TApdAbstractTapiStatus then begin
        if not Assigned(FStatusDisplay) then
          if not Assigned(TApdAbstractTapiStatus(AComponent).FTapiDevice) then
            StatusDisplay := TApdAbstractTapiStatus(AComponent);
      end;

      {Check for new log component}
      if AComponent is TApdTapiLog then begin
        if not Assigned(FTapiLog) then
          if not Assigned(TApdTapiLog(AComponent).FTapiDevice) then
            TapiLog := TApdTapiLog(AComponent);
      end;
    end;
  end;

  procedure TApdCustomTapiDevice.Loaded;                                 {!!.02}
  begin
    inherited;
    if not Assigned(FComPort) then begin
      FComPort := SearchComPort(Owner);
      if Assigned(FComPort) and (ComPort.TapiMode = tmAuto) then begin
        ComPort.TapiMode := tmOn;
        ComPort.AutoOpen := False;
        ComPort.Open := False;
      end;
    end;
  end;

  constructor TApdCustomTapiDevice.Create(AOwner : TComponent);
    {-Create the object instance}
  begin
    {This causes notification events for all other components}
    inherited Create(AOwner);
    {Create the TAPI name string list}
    FTapiDevices := TStringList.Create;

    FSilence.AppSpecific := 5;
    FSilence.Duration := 5000;
    FSilence.Frequency1 := 0;
    FSilence.Frequency2 := 0;
    FSilence.Frequency3 := 0;

    {Private inits}
    LineApp         := 0;
    LineHandle      := 0;
    CallHandle      := 0;
    SelectedLine    := -1;
    RetryPending    := False;
    FillChar(LineExt, SizeOf(LineExt), 0);
    FDialTime       := 0;
    PassThruMode    := False;

    {Property inits}
    FDialing         := False;
    FSelectedDevice  := '';
    FDeviceCount     := 0;
    FOpen            := False;
    FCallInfo        := nil;
    FAnsRings        := DefAnsRings;
    FMaxAttempts     := DefMaxAttempts;
    FAttempt         := 0;
    FRetryWait       := DefRetryWait;
    FShowTapiDevices := DefShowTapiDevices;
    FShowPorts       := DefShowPorts;
    FWaveState       := wsIdle;
    FInterruptWave   := True;
    FMaxMessageLength:= DefMaxMessageLength;
    FWaveState       := DefWaveState;
    FUseSoundCard    := DefUseSoundCard;
    FTrimSeconds     := DefTrimSeconds;
    FSilenceThreshold:= DefSilenceThreshold;
    Channels         := DefChannels;
    SamplesPerSecond := DefSamplesPerSecond;
    BitsPerSample    := DefBitsPerSample;
    FMonitorRecor