unidevice_tapi.pas

很好用的串口通信工具软件。Comport目录下是用到的通信控件。

        if Assigned(LineCaps) then
          FreeMem(LineCaps, LineCaps^.TotalSize);
      end;
    end
    else
      FAllTapiDevices.Add(nullDevice);
  end;
end;

function TCustomTAPIDriver.OpenSelectedDevice: Boolean;
{ 打开选定的TAPI设备。此设备在FDeviceID中指定}
{注意：一定要先设定FAutoAnswer值。}
var
  CallPrivilege: LongInt;
  DeviceID: Integer; // TAPI 设备ID
begin
  DeviceID := FAllTapiDevices.IndexOf(FSelectedDevice);
  if (LineApp = 0) or (DeviceID = -1) or (FSelectedDevice = nullDevice) then
  begin
    Result := False; { 尚未初始化或未选择线路设备 }
    Exit;
  end;
  if FAutoAnswer then
    CallPrivilege := LINECALLPRIVILEGE_MONITOR + LINECALLPRIVILEGE_OWNER
  else
    CallPrivilege := LINECALLPRIVILEGE_NONE;
  Result := tuLineOpen(LineApp, DeviceID, LineHandle, FApiVersion, 0,
    LongInt(Self), CallPrivilege, LINEMEDIAMODE_DATAMODEM, 0) = Success;
  FDeviceOpened := Result;
  {
  //如果要播送语音则使用下列函数调用
  Result := tuLineOpen(LineApp, DeviceID, LineHandle, FApiVersion, 0,
    LongInt(Self), CallPrivilege, LINEMEDIAMODE_AUTOMATEDVOICE, 0) = Success;
  }
  tuLineSetStatusMessages(LineHandle, AllLineDeviceStates, AllAddressStates);
end;

function TCustomTAPIDriver.CloseSelectedDevice: Boolean;
{关闭指定的TAPI设备。此设备在FDeviceID中指定}
var
  AOnTapiHangup: TTapiHangupEvent;
begin
  Result := False;
  AOnTapiHangup := FOnTapiHangup;
  FOnTapiHangup := nil;
  Hangup('关闭' + FSelectedDevice);
  FOnTapiHangup := AOnTapiHangup;
  LineHandle := 0;
  TAPILog('CloseSelectedDevice: CallHandle := 0');
  CallHandle := 0;
  FDeviceOpened := False;
end;

function TCustomTAPIDriver.Hangup(Reason: string): Boolean;
{挂断当前呼叫}
var GlobeCallhandle: THandle;
  GlobalLineHandle: THandle;
begin
  Result := False;
  FConnected := False;
  if StoppingCall then
  begin
    TAPILog('Hangup: 已经正在Hangup, 等待...');
    Exit;
  end;
  if LineHandle = 0 then Exit;
  StoppingCall := True;
  GlobeCallHandle := CallHandle;
  GlobalLineHandle := LineHandle;
  try
    if GlobeCallHandle <> 0 then
    begin
      { Only drop the call when the line is not idle }
      if TapiCallState <> tsIdle then
      begin
        //cheer wind 2001.6.27
        //在此期间,可能有Line_Disconnected 消息,
        //调用CloseSelectedDevice时会导致CallHandle变为0
        //因此预存CallHandle 到CallHandle中
        WaitForReply(tuLineDrop(GlobeCallHandle, nil, 0));
        WaitForCallState(LineCallState_Idle);
      end;
      { The call is now idle -- deallocate it }
      Result := tuLineDeallocateCall(GlobeCallHandle) = Success;
    end;
    CallHandle := 0;
    if HLineID <> INVALID_HANDLE_VALUE then
    begin
      CloseHandle(HLineID);
      HLineID := INVALID_HANDLE_VALUE;
    end;

    if GlobalLineHandle <> 0 then
      Result := tuLineClose(GlobalLineHandle) = Success;
    LineHandle := 0;
  finally
    StoppingCall := False;
    NotifyTapiHangup(reason);
  end;
end;

procedure TCustomTAPIDriver.DoLineReply(Device, P1, P2, P3: LongInt);
{Line_Reply消息处理。当TAPI异步调用完成后会产生此消息}
begin
  if (RequestedId = P1) then
  begin
    AsyncReplyReceived := True;
    AsyncReplyData := P2;
  end;
end;

procedure TCustomTAPIDriver.DoLineCallState(Device, P1, P2, P3: LongInt);
{当前呼叫消息处理}
begin
  CallState := P1;
  CallStateReceived := True;
  case P1 of
    // 检测到拨号音
    LineCallState_Dialtone: NotifyTAPIStatus(True, False, Device, Line_CallState, P1, P2, P3);
    // 正在呼叫
    LineCallState_Dialing: NotifyTAPIStatus(False, False, Device, Line_CallState, P1, P2, P3);
    // 呼叫完毕，等待回应
    LineCallState_Proceeding: NotifyTAPIStatus(False, False, Device, Line_CallState, P1, P2, P3);
    // 检测到回铃音
    LineCallState_Ringback: NotifyTAPIStatus(False, False, Device, Line_CallState, P1, P2, P3);
    // 检测到忙音。需挂机
    LineCallState_Busy:
      begin
        NotifyTAPIStatus(False, False, Device, Line_CallState, P1, P2, P3);
        Hangup('忙音');
      end;
    // 呼叫空闲。需挂机
    LineCallState_Idle:
      begin
        NotifyTAPIStatus(False, False, Device, Line_CallState, P1, P2, P3);
        Hangup('呼叫空闲');
      end;
    // 收到特殊信息。表明呼叫已不可能完成。需挂机
    LineCallState_SpecialInfo:
      begin
        NotifyTAPIStatus(False, False, Device, Line_CallState, P1, P2, P3);
        Hangup('特殊信息。无法呼叫');
      end;
    // 对方已经挂机。需挂机
    LineCallState_Disconnected:
      begin
        NotifyTAPIStatus(False, False, Device, Line_CallState, P1, P2, P3);
        Hangup('连接中断');
      end;
    // 检测到振铃。
    LineCallState_Offering:
      begin
        { Update the CallInfo record }
        UpdateCallInfo(Device);
        {Note the call handle}
        CallHandle := Device;
        {Start showing status}
        NotifyTAPIStatus(True, False, Device, Line_CallState, P1, P2, P3);
        {Accept the call}
        if (FAutoAnswer) and (P3 >= FAnsRings) then
        begin
          WaitForReply(tuLineAccept(CallHandle, nil, 0));
        end;
      end;
    // 呼叫已被接收
    LineCallState_Accepted:
      begin
        NotifyTAPIStatus(False, False, Device, Line_CallState, P1, P2, P3);
      end;
    // 双方已经建立连接。可以收发数据了。
    LineCallState_Connected:
      begin
        { 一次呼叫中可能多次收到此信息 }
        if FConnected then Exit;
        { Update the CallInfo record }
        UpdateCallInfo(Device);
        { Say we're connected }
        FConnected := True;
        HLineID := GetLineID;
        // to do
        {Show last status}
        NotifyTAPIStatus(False, True, Device, Line_CallState, P1, P2, P3);
        {Generate the TAPI connect event}
        NotifyTapiConnect;
      end;
  end;
end;

procedure TCustomTAPIDriver.DoLineClose(Device, P1, P2, P3: LongInt);
{检测到Line_Close消息的处理。表明设备已经被强制关闭。}
{此时LineHanlde和CallHandle不再有效。}
begin
  LineHandle := 0;
  TAPILog('DoLineClose: CallHandle := 0');
  CallHandle := 0;
  FConnected := False;
  if HLineID <> INVALID_HANDLE_VALUE then
  begin
    CloseHandle(HLineID);
    HLineID := INVALID_HANDLE_VALUE;
  end;
  if Assigned(FOnTAPIHangup) then
    FOnTAPIHangup(self, '设备已经被强制关闭');
end;

procedure TCustomTAPIDriver.DoLineCreate(Device, P1, P2, P3: LongInt);
{收到消息：系统加入了新的TAPI设备。需更新TAPI设备列表}
begin
  if (FDeviceCount <= DWORD(P1)) then
    FDeviceCount := P1 + 1;
  EnumLineDevices;
  TAPILog(Separater);
  TAPILog('Line_Create');
end;

procedure TCustomTAPIDriver.DoLineDevState(Device, P1, P2, P3: LongInt);
{收到设备状态变化消息}
begin
  TAPILog(Separater);
  case P1 of
    LineDevState_Ringing:
      begin
        TAPILog('LineDevState_Ringing');
        {Answer the Call}
        if (FAutoAnswer) and (P3 >= FAnsRings) then
          WaitForReply(tuLineAnswer(CallHandle, nil, 0));
        {Show status}
        NotifyTAPIStatus(False, False, Device, Line_LineDevState, P1, P2, P3);
      end;

    LineDevState_OutOfService:
      begin
        TAPILog('LineDevState_OutOfService');
        Hangup('当前线路无此功能');
      end;
    LineDevState_Disconnected:
      begin
        TAPILog('LineDevState_Disconnected');
        Hangup('线路连接中断');
      end;
    LineDevState_Maintenance:
      begin
        TAPILog('LineDevState_Maintenance');
        Hangup('Maintenance');
      end;
  else if (P1 = LineDevState_Reinit) then
  begin
    case P2 of
      0:
        begin
          TAPILog('LineDevState_Reinit - shutDown');
          ShutDown; {"real" REINIT message - must shutdown}
        end;
      Line_Create: DoLineCreate(Device, P3, 0, 0);
      Line_LineDevState: DoLineDevState(Device, P3, 0, 0);
    end;
  end
  else
    TAPILog(Format('Unhandled LineDevState P1:%4.4X, P2:%4.4X, P3:%4.4X', [P1, P2, P3]));
  end;
end;


function TCustomTAPIDriver.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
      AsyncReplyReceived := False;
      RequestedID := ID;
      AsyncReplyData := LineErr_OperationFailed;
      while (not AsyncReplyReceived) and (WaitForSingleObject(Event_ShutDown, 10) <> WAIT_OBJECT_0) do
      begin
        Application.ProcessMessages;
        if (LineHandle = 0) then
        begin
          Result := WaitErr_WaitAborted;
          Exit;
        end;
        if (GetTickCount - TimeStart) > WaitTimeout then
        begin
          Result := WaitErr_WaitTimedout;
          Exit;
        end;
      end;
      Result := AsyncReplyData;
      Exit;
    end;
  finally
    ReplyWait := False;
  end;
  Result := ID;
end;

function TCustomTAPIDriver.WaitForCallState(DesiredCallState: LongInt): LongInt;
var
  TimeStart: DWORD;
begin
  CallStateReceived := False;
  TimeStart := GetTickCount;
  while (DesiredCallState = LineCallState_Any) or
    (CallState <> DesiredCallState) do
  begin
    Application.ProcessMessages;
    WaitForSingleObject(Event_ShutDown, 10);
    if (DesiredCallState = LineCallState_Any) and CallStateReceived then
      Break;
    if (LineHandle = 0) then
    begin
      Result := WaitErr_WaitAborted;
      Exit;
    end;
    if (GetTickCount - TimeStart) > WaitTimeout then
    begin
      Result := WaitErr_WaitTimedout;
      Exit;
    end;
  end;
  Result := Success;
end;

function TCustomTAPIDriver.GetCallState: TTapiCallState;
{取得当前呼叫的状态 }
var
  CurrentCallStatus: PCallStatus;
begin
  if CallHandle <> 0 then
  begin
    tuLineGetCallStatusDyn(CallHandle, CurrentCallStatus);
    try
      case CurrentCallStatus^.CallState of
        LineCallState_Idle: Result := tsIdle;
        LineCallState_Offering: Result := tsOffering;
        LineCallState_Accepted: Result := tsAccepted;
        LineCallState_Dialtone: Result := tsDialTone;
        LineCallState_Dialing: Result := tsDialing;
        LineCallState_Ringback: Result := tsRingBack;
        LineCallState_Busy: Result := tsBusy;
        LineCallState_SpecialInfo: Result := tsSpecialInfo;
        LineCallState_Connected: Result := tsConnected;
        LineCallState_Proceeding: Result := tsProceeding;
        LineCallState_OnHold: Result := tsOnHold;
        LineCallState_Conferenced: Result := tsConferenced;
        LineCallState_OnHoldPendConf: Result := tsOnHoldPendConf;
        LineCallState_OnHoldPendTransfer: Result := tsOnHoldPendTransfer;
        LineCallState_Disconnected: Result := tsDisconnected;
      else
        Result := tsUnknown;
      end;
    finally
      FreeMem(CurrentCallStatus, CurrentCallStatus^.TotalSize);
    end;
  end
  else
    Result := tsIdle;
end;

procedure TCustomTAPIDriver.NotifyTAPIStatus(First, Last: Boolean;
  Device, Message, Param1, Param2, Param3: DWORD);
{处理 TAPI 状态回调}
begin
  if Assigned(FOnTapiStatus) and not ((Message = 0) and (Param1 = 0)
    and (Param2 = 0) and (Param3 = 0)) then
    FOnTapiStatus(Self, First, Last, Device, Message, Param1, Param2, Param3);
end;

procedure TCustomTAPIDriver.UpdateCallInfo(Device: LongInt);
{更新当前呼叫信息。信息存放于FCallInfo中。当检测到振铃以及建立连接时需调用，以取得详细呼叫信息}
begin
  if Assigned(FCallInfo) then
  begin
    FreeMem(FCallInfo, FCallInfo^.TotalSize);
    FCallInfo := nil;
  end;
  tuLineGetCallInfoDyn(Device, FCallInfo);
end;

procedure TCustomTAPIDriver.NotifyTapiConnect;
{收到连接成功的消息的处理}
begin
  FEventThread := TTAPIThread.Create(self, HLineID);
  if Assigned(FOnTapiConnect) then
    FOnTapiConnect(Self);
end;

procedure TCustomTAPIDriver.NotifyTapiHangup(reason: string);
{收到连接成功的消息的处理}
begin
  if Assigned(FEventThread) then
  begin
    FEventThread.Stop;
    FEventThread.Terminate;
    FEventThread.free;
    FEventThread := nil;
  end;
  if Assigned(FOnTapiHangup) then
    FOnTapiHangup(self, reason);
end;

procedure TCustomTAPIDriver.Call(Phone: string);
{拨号呼叫}
var
  CallParams: TLineCallParams;
  NumPhone: array[0..255] of Char;
begin
  FillChar(CallParams, SizeOf(CallParams), 0);
  with CallParams do
  begin
    TotalSize := SizeOf(CallParams);
    BearerMode := LINEBEARERMODE_VOICE;
    MediaMode := LINEMEDIAMODE_DATAMODEM;
    CallParamFlags := LINECALLPARAMFLAGS_IDLE;
    AddressMode := LINEADDRESSMODE_ADDRESSID;
    AddressID := 0;
  end;
  if WaitForReply(tuLineMakeCall(LineHandle, CallHandle, StrPCopy(NumPhone, Phone), 0, @CallParams)) < 0 then
    Hangup;
end;

procedure TCustomTAPIDriver.SetSelectedDevice(value: string);
{设定选定的设备}
begin
  if (value = nullDevice) or (FAllTapiDevices.IndexOf(value) = -1) then
    raise Exception.Create('不存在此设备');
  FSelectedDevice := value;
end;

function TCustomTAPIDriver.GetLineID: DWord;
{-Return CommHandle from the current TAPI session}
begin
  {Get a handle to the comm port}
  FillChar(VS, SizeOf(TVarString), 0);
  VS.TotalSize := SizeOf(TVarString);
  if tuLineGetID(LineHandle, 0, CallHandle, LINECALLSELECT_CALL,
    VS, 'comm/datamodem') = 0 then
    with VS do
      Move(StringData[StringOffset], Result, SizeOf(Result))
  else
    Result := INVALID_HANDLE_VALUE;
end;

function TCustomTAPIDriver.BPS: DWORD;
    {-Return the BPS rate of the current call}
begin
  if Assigned(FCallInfo) and FConnected then
    Result := FCallInfo^.Rate
  else
    Result := 0;
end;

function TCustomTAPIDriver.InputCount: Integer;
var
  Errors: DWORD;
  ComStat: TComStat;
begin
  if not ClearCommError(HLineID, Errors, @ComStat) then
    Result := 0
  else
    Result := ComStat.cbInQue;