INCOMING.FRM
VERSION 5.00
Begin VB.Form Form1
Caption = "Incoming"
ClientHeight = 5025
ClientLeft = 60
ClientTop = 345
ClientWidth = 4800
LinkTopic = "Form1"
ScaleHeight = 5025
ScaleWidth = 4800
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton pbDisconnect
Caption = "Disconnect"
Height = 375
Index = 1
Left = 1440
TabIndex = 3
Top = 2760
Width = 2055
End
Begin VB.CommandButton pbAnswer
Caption = "Answer"
Default = -1 'True
Height = 375
Index = 0
Left = 1440
TabIndex = 2
Top = 2160
Width = 2055
End
Begin VB.CommandButton RegisterForReceiveCall
Caption = "Register the Application for Receiving Calls"
Height = 615
Left = 1440
TabIndex = 1
Top = 1200
Width = 2055
End
Begin VB.Frame Frame1
Caption = "Register"
Height = 1815
Left = 240
TabIndex = 4
Top = 240
Width = 4335
Begin VB.ComboBox cmbAddressTypes
Height = 315
Left = 1800
TabIndex = 0
Top = 360
Width = 2175
End
Begin VB.Label Label1
Caption = "Calls you want to receive:"
Height = 495
Left = 360
TabIndex = 5
Top = 360
Width = 1095
End
End
Begin VB.Label lblStatus
Height = 1335
Left = 1080
TabIndex = 7
Top = 3480
Width = 3495
End
Begin VB.Label lblStatusTitle
Caption = "Status:"
Height = 255
Left = 360
TabIndex = 6
Top = 3480
Width = 615
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' INCOMING.EXE
'
' Example of receiving calls with TAPI 3.0
'
' This application will allow a user to receive audio calls
' by using TAPI 3.0.
'
' The application will simply look for the 1st address that is able
' to receive calls of the specified type (phone calls, or h323 calls -
' the user is allowed to decide). The address is also chosen
' only if it supports at least 2 media types (the idea is that
' usually the first 2 media types will be "audio in" and "audio out").
' It will register then itself on this address to receive calls.
' On the received calls, it will select 2 media terminals before
' calling answer. The media terminals are created by using the
' first 2 media types enumerated by the address, with their default
' terminals.
' The app will display messages to announce whenever a new call
' arrives and also when a call state event fires.
'
' This application does not make outgoing calls.
'
Option Explicit
Dim gobjTapi As TAPI
Dim gobjDestAddress As Address
Dim WithEvents gobjAddressWithEvents As Address
Attribute gobjAddressWithEvents.VB_VarHelpID = -1
Dim gobjTerminal1 As Terminal
Dim gobjTerminal2 As Terminal
Dim gguidMediaType1
Dim gguidMediaType2
Dim gobjReceivedCallInfo As ITCallInfo
Dim gbSupportedCall As Boolean
Private Sub Form_Load()
pbAnswer(0).Enabled = False
'populate combo box with names of call types
'attach to each combo item the address type that
'can receive that type of call
cmbAddressTypes.AddItem ("Phone Calls")
cmbAddressTypes.ItemData(cmbAddressTypes.NewIndex) = ADDRESSTYPE_PHONENUMBER
cmbAddressTypes.AddItem ("H323 Calls")
cmbAddressTypes.ItemData(cmbAddressTypes.NewIndex) = ADDRESSTYPE_IPADDRESS
'set selection on 1st item
cmbAddressTypes.ListIndex = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
'release all global objects
Set gobjReceivedCallInfo = Nothing
Set gobjTerminal1 = Nothing
Set gobjTerminal2 = Nothing
Set gobjAddressWithEvents = Nothing
Set gobjDestAddress = Nothing
If Not (gobjTapi Is Nothing) Then
gobjTapi.Shutdown
End If
Set gobjTapi = Nothing
'empty combo box
Dim i
For i = 1 To cmbAddressTypes.ListCount
cmbAddressTypes.RemoveItem (0)
Next i
End Sub
Private Sub DisplayCallState(State As CALL_STATE)
Dim strMsg As String
Select Case State
Case CS_CONNECTED
strMsg = "call state: CS_CONNECTED" & Chr(13)
strMsg = strMsg & "The call was answered, now you can disconnect "
strMsg = strMsg & "or wait for disconnected state. "
strMsg = strMsg & "Don't press Answer before new call arrives. "
lblStatus.Caption = strMsg
Case CS_DISCONNECTED
strMsg = "call state: CS_DISCONNECTED" & Chr(13)
strMsg = strMsg & "Call will be released. "
strMsg = strMsg & "New incoming calls will be accepted. "
lblStatus.Caption = strMsg
Case CS_HOLD
lblStatus.Caption = "call state: CS_HOLD"
Case CS_IDLE
lblStatus.Caption = "call state: CS_IDLE"
Case CS_INPROGRESS
lblStatus.Caption = "call state: CS_INPROGRESS"
Case CS_OFFERING
If gbSupportedCall = True Then
strMsg = "call state: CS_OFFERING"
strMsg = strMsg & Chr(13) & "A call was received. You can answer it"
lblStatus.Caption = strMsg
End If
Case CS_QUEUED
lblStatus.Caption = "call state: CS_QUEUED"
Case Else
lblStatus.Caption = "call state: unknown!!"
End Select
End Sub
Private Sub pbAnswer_Click(index As Integer)
Dim strMsg
If gobjReceivedCallInfo Is Nothing Then
strMsg = "There is no call to be answered!"
lblStatus.Caption = strMsg
Exit Sub
End If
If Not (gobjReceivedCallInfo.CallState = CS_OFFERING) Then
strMsg = "Cannot answer call that doesn't have offering state."
strMsg = strMsg & " Did you already press Answer?"
lblStatus.Caption = strMsg
Exit Sub
End If
'query ITBasicCallControl, the call control interface
Dim objCallControl As ITBasicCallControl
Set objCallControl = gobjReceivedCallInfo
'
'prepare the terminals (take the default terminals)
'
'query ITTerminalSupport from Address object
Dim objTerminalSupport As ITTerminalSupport
Set objTerminalSupport = gobjDestAddress
Set gobjTerminal1 = objTerminalSupport.GetDefaultTerminal(gguidMediaType1)
Set gobjTerminal2 = objTerminalSupport.GetDefaultTerminal(gguidMediaType2)
'release not needed objects
Set objTerminalSupport = Nothing
'Select the media-terminals before answering
'Create the media-terminals, then put them in array,
'then put array in variant
Dim MediaTerminals As Variant
Dim arrMediaTerminals(0 To 1) As ITMediaTerminal
MediaTerminals = arrMediaTerminals
Set MediaTerminals(0) = gobjTapi.CreateMediaTerminal( _
gguidMediaType1, gobjTerminal1)
Set MediaTerminals(1) = gobjTapi.CreateMediaTerminal( _
gguidMediaType2, gobjTerminal2)
objCallControl.SelectMediaTerminals (MediaTerminals)
Set MediaTerminals(0) = Nothing
Set MediaTerminals(1) = Nothing
Set gobjTerminal1 = Nothing
Set gobjTerminal2 = Nothing
'Answer
objCallControl.Answer
'disable the button
pbAnswer(0).Enabled = False
'release the call control interface
Set objCallControl = Nothing
End Sub
Private Sub pbDisconnect_Click(index As Integer)
If gobjReceivedCallInfo Is Nothing Then
Dim strMsg As String
strMsg = "There is no call to be disconnected."
lblStatus.Caption = strMsg
Exit Sub
End If
'disconnect the call: need to query its call control interface for this
Dim objCallControl As ITBasicCallControl
Set objCallControl = gobjReceivedCallInfo
objCallControl.Disconnect (DC_NORMAL)
'release the call control interface
Set objCallControl = Nothing
End Sub
'this "callback" function must be reentrant
Private Sub gobjAddressWithEvents_CallEventNotification(ByVal pAddress As TAPI3Lib.ITAddress, ByVal CallEventType As TAPI3Lib.CALL_EVENT_TYPE, ByVal pEvent As Object)
Dim strMsg
If CallEventType = CET_CALLOWNER Then
gbSupportedCall = True
If Not (gobjReceivedCallInfo Is Nothing) Then
gbSupportedCall = False
strMsg = "This app doesn't support a second call. "
strMsg = strMsg & "Unsupported second call will be rejected!"
lblStatus.Caption = strMsg
'pEvent is declared as Object, so for using it you must
'query its call control interface, ITBasicCallControl
Dim objReceivedCallControl As ITBasicCallControl
Set objReceivedCallControl = pEvent
'Reject the not supported call by calling Disconnect
'Note: this second call will arrive only if tapi provider
'supports more than 1 call per address.
Dim code As DISCONNECT_CODE
code = DC_REJECTED
objReceivedCallControl.Disconnect (code)
'release all objects that are not needed any longer
'it is important to release also the received object pEvent
Set objReceivedCallControl = Nothing
Set pEvent = Nothing
Exit Sub
End If
'query ITCallInfo interface from pEvent, and store it
Set gobjReceivedCallInfo = pEvent
'reenable the button
pbAnswer(0).Enabled = True
End If
If CallEventType = CET_CALLSTATEEVENT Then
'for this type of event, the object pEvent must be
'queried for its ITCallStateEvent interface
Dim objCallStateEvent As ITCallStateEvent
Set objCallStateEvent = pEvent
Dim State As CALL_STATE
Dim objEventCallInfo As ITCallInfo
'extract the call object from pEvent (from its
'ITCallStateEvent interface)
Set objEventCallInfo = objCallStateEvent.Call
State = objCallStateEvent.State
DisplayCallState (State)
If objEventCallInfo Is gobjReceivedCallInfo Then
If State = CS_DISCONNECTED Then
'after call is disconnected, you don't need
'its object anymore; you can only release it
Set gobjReceivedCallInfo = Nothing
End If
End If
'release not needed objects
Set objEventCallInfo = Nothing
Set objCallStateEvent = Nothing
End If
'always release the received pEvent
Set pEvent = Nothing
Exit Sub
End Sub
Private Sub RegisterForReceiveCall_Click()
If Not (gobjTapi Is Nothing) Then
Dim strMsg
strMsg = "You already did that :-)"
strMsg = strMsg & Chr(13)
strMsg = strMsg & "Restart the app if you want to register another address."
lblStatus.Caption = strMsg
Exit Sub
End If
RegisterForReceiveCall.MousePointer = vbHourglass
'create the tapi object
Set gobjTapi = New TAPI
'call Initialize before calling any other tapi function
gobjTapi.Initialize
'pick up the collection of addresses
Dim objcollAddress As ITCollection
Set objcollAddress = gobjTapi.Addresses
'search address that supports the desired address type
Dim nAddressIndex
nAddressIndex = FindAddressIndex(objcollAddress)
If nAddressIndex < 1 Or nAddressIndex > objcollAddress.Count Then
strMsg = "Could not find an appropriate address for this address type!" & _
Chr(13) & "Need 2 media types at least to be available on that address."
lblStatus.Caption = strMsg
'release all objects
Set objcollAddress = Nothing
If Not (gobjTapi Is Nothing) Then
gobjTapi.Shutdown
End If
Set gobjTapi = Nothing
RegisterForReceiveCall.MousePointer = vbDefault
Exit Sub
End If
'pick up the "N"-th address - the address on which
'you want to receive calls
Set gobjDestAddress = objcollAddress.Item(nAddressIndex)
Set objcollAddress = Nothing 'no more needed, release
'
'pick up first 2 media types supported by this address
'
Dim objMediaSupport As ITMediaSupport
Dim objCollMediaTypes As ITCollection
'query ITMediaSupport interface from Address object
Set objMediaSupport = gobjDestAddress
'pick up the collection of media types
Set objCollMediaTypes = objMediaSupport.MediaTypes
gguidMediaType1 = objCollMediaTypes.Item(1)
gguidMediaType2 = objCollMediaTypes.Item(2)
'release not needed objects
Set objMediaSupport = Nothing
Set objCollMediaTypes = Nothing
'
'pick up the default terminal for each media type
'
' Dim objTerminalSupport As ITTerminalSupport
'
' 'query ITTerminalSupport from Address object
' Set objTerminalSupport = gobjDestAddress
'
' Set gobjTerminal1 = objTerminalSupport.GetDefaultTerminal(gguidMediaType1)
' Set gobjTerminal2 = objTerminalSupport.GetDefaultTerminal(gguidMediaType2)
'
' 'release not needed objects
' Set objTerminalSupport = Nothing
'
'register (specify) media types for which you want
'to receive calls;
'only calls that have this media type will be offered to the app
'the media types must be passed to RegisterCallTypes in
'an array contained in a variant
Dim arrMediaTypes(0 To 1) As String
Dim bOutgoing, bOwner, bMonitor
Dim MediaTypes As Variant
bOutgoing = False
'bOwner = True ensures that app receives incoming calls
'and their call state events
bOwner = True
bMonitor = False
arrMediaTypes(0) = gguidMediaType1
arrMediaTypes(1) = gguidMediaType2
MediaTypes = arrMediaTypes
Call gobjDestAddress.RegisterCallTypes(bOutgoing, bOwner, _
bMonitor, MediaTypes)
'register the outgoing interface (the one that will actually
'receive and process the events)
On Error Resume Next
Set gobjAddressWithEvents = gobjDestAddress
If Err.Number <> 0 Then
strMsg = "Registering for receiving calls failed." & Chr(13) & _
"If you have a data modem, replace it with a voice modem"
strMsg = strMsg & "Quit the app and try again."
lblStatus.Caption = strMsg
RegisterForReceiveCall.MousePointer = vbDefault
Exit Sub
End If
'from now on the app is able to receive calls made on the
'specified address, with the specified media type
RegisterForReceiveCall.MousePointer = vbDefault
lblStatus.Caption = "Waiting for a call..."
End Sub
'Search through all addresses and return the index of the one that matches
'the address type selected in the combo box with address types. Also, the
'found address must support at least 2 media types (so that later we can
'safely use the first and second media type).
'Note: usually, the first 2 media types are "audio in" and "audio out".
'Return 0 if no address found. Otherwise return its index, which will be
'between 1 and Addresses.Count
Private Function FindAddressIndex(objCollAddresses As ITCollection) As Long
Dim nSelectedType As Long
Dim indexAddr As Long, indexType As Long
Dim objCrtAddress As Address
Dim objCollAddrTypes As ITCollection
Dim objMediaSupport As ITMediaSupport
Dim objCollMediaTypes As ITCollection
Dim bFound As Boolean
'
'retrieve from combo box the type of the selected address type
'
nSelectedType = cmbAddressTypes.ItemData(cmbAddressTypes.ListIndex)
'
'search through all addresses the first one that matches this type
'and also supports at least one media type
'
bFound = False
For indexAddr = 1 To objCollAddresses.Count
Set objCrtAddress = objCollAddresses.Item(indexAddr)
Set objMediaSupport = objCrtAddress
Set objCollMediaTypes = objMediaSupport.MediaTypes
If objCollMediaTypes.Count >= 2 Then
Set objCollAddrTypes = objCrtAddress.AddressTypes
For indexType = 1 To objCollAddrTypes.Count
If nSelectedType = objCollAddrTypes.Item(indexType) Then
bFound = True
Exit For
End If
Next indexType
Set objCollAddrTypes = Nothing
End If
Set objCollMediaTypes = Nothing
Set objMediaSupport = Nothing
Set objCrtAddress = Nothing
If bFound = True Then Exit For
Next indexAddr
'
'return the index of the found address, or 0 if no address found
'
If bFound = True Then
FindAddressIndex = indexAddr
Else
FindAddressIndex = 0
End If
Exit Function
End Function