VERSION 5.00
Begin VB.Form Form1
Caption = "Async"
ClientHeight = 4260
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4260
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.ComboBox cmbAddressTypes
Height = 315
Left = 1920
Style = 2 'Dropdown List
TabIndex = 0
Top = 720
Width = 2295
End
Begin VB.CommandButton pbDial
Caption = "Dial"
Default = -1 'True
Height = 375
Index = 0
Left = 960
TabIndex = 2
Top = 1920
Width = 3135
End
Begin VB.CommandButton pbDisconnect
Caption = "Disconnect"
Height = 375
Index = 1
Left = 960
TabIndex = 3
Top = 2520
Width = 3135
End
Begin VB.TextBox txtDestAddress
Height = 375
Left = 1920
TabIndex = 1
Top = 1320
Width = 2295
End
Begin VB.Label lblStatus
Height = 855
Left = 1800
TabIndex = 7
Top = 3120
Width = 2415
End
Begin VB.Label lblStatusTitle
Caption = "Status:"
Height = 255
Left = 480
TabIndex = 6
Top = 3120
Width = 855
End
Begin VB.Label Label2
Caption = "Address:"
Height = 255
Left = 480
TabIndex = 5
Top = 1320
Width = 1095
End
Begin VB.Label Label1
Caption = "Address Type:"
Height = 255
Left = 480
TabIndex = 4
Top = 720
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ASYNC.EXE
'
' Example of making an asynchronous outgoing call with TAPI 3.0
'
' This application will allow a user to make an asynchronous call
' by using TAPI 3.0. The application will simply look for the 1st address
' that matches the address type selected by the user in the combo box.
' It will actually pick up the address that also supports at least the
' media types audio in and audio out (therefore it will skip all others,
' even if they match the desired address type).
' It will then use that address to make calls. On the call, it will
' select the media types "audio in" and "audio out", and, if these are supported
' too, it will also select the media types "video in" and "video out"; for each
' of these media types it will use their default terminals; except for video in
' which needs a dynamic terminal to be created.
' The name of the destination address is taken by means of an edit box.
' The app will display messages to announce whenever a state event fires.
'
' This application has the limitation that it only supports one call
' at a time. But Tapi 3.0 has support for multiple calls per address,
' and the number of calls per address is dictated actually by the
' provider. (e.g. Unimodem would allow only 1 call per address at a time)
'
' This application doesn't have code for error handling.
'
' This application does not handle incoming calls.
'
' TBD: there is a bug when null terminal is selected for video out
' (this happens when no video card is installed). The sample has some
' temporary code to handle it, this code must be removed when the bug is
' fixed.
'
Option Explicit
Dim gnPreviousAddressIndex As Long
Dim WithEvents gobjAddressWithEvents As Address
Attribute gobjAddressWithEvents.VB_VarHelpID = -1
Dim gobjOrigAddress As Address
Dim gobjTapi As TAPI
Dim gobjCall As ITBasicCallControl
Private Sub Form_Load()
gnPreviousAddressIndex = 0 'valid indexes are between 1 and addresses count
'populate combo box with names of all addresses types
'attach to each combo item the address type itself
cmbAddressTypes.AddItem ("Phone Number")
cmbAddressTypes.ItemData(cmbAddressTypes.NewIndex) = ADDRESSTYPE_PHONENUMBER
cmbAddressTypes.AddItem ("Email Name")
cmbAddressTypes.ItemData(cmbAddressTypes.NewIndex) = ADDRESSTYPE_EMAILNAME
cmbAddressTypes.AddItem ("Machine Name")
cmbAddressTypes.ItemData(cmbAddressTypes.NewIndex) = ADDRESSTYPE_DOMAINNAME
cmbAddressTypes.AddItem ("IP Address")
cmbAddressTypes.ItemData(cmbAddressTypes.NewIndex) = ADDRESSTYPE_IPADDRESS
cmbAddressTypes.AddItem ("Conference Name")
cmbAddressTypes.ItemData(cmbAddressTypes.NewIndex) = ADDRESSTYPE_CONFERENCENAME
'set selection on 1st item
cmbAddressTypes.ListIndex = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
'release all global variables
Set gobjCall = Nothing
Set gobjAddressWithEvents = Nothing
Set gobjOrigAddress = 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 PrintCallState(State As CALL_STATE)
Select Case State
Case CS_CONNECTED
lblStatus.Caption = "call state: CS_CONNECTED"
Case CS_DISCONNECTED
Dim strMsg
strMsg = "call state: CS_DISCONNECTED"
strMsg = strMsg & Chr(13) & "Call was disconnected. "
strMsg = strMsg & "Now you can press Connect again or just quit."
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
lblStatus.Caption = "call state: CS_OFFERING"
Case CS_QUEUED
lblStatus.Caption = "call state: CS_QUEUED"
Case Else
lblStatus.Caption = "call state: unknown!!"
End Select
End Sub
Private Sub gobjAddressWithEvents_CallEventNotification(ByVal pAddress As TAPI3Lib.ITAddress, ByVal CallEventType As TAPI3Lib.CALL_EVENT_TYPE, ByVal pEvent As Object)
Dim objCallStateEvent As ITCallStateEvent
If CallEventType <> CET_CALLSTATEEVENT Then
'I am interested only by CallStateEvent-s
lblStatus.Caption = "Event type <> CET_CALLSTATEEVENT ignored."
Set pEvent = Nothing
Exit Sub
End If
'pEvent is an unknown object; query its ITCallStateEvent interface
Set objCallStateEvent = pEvent
PrintCallState (objCallStateEvent.State)
If objCallStateEvent.State = CS_DISCONNECTED Then
'release call, you don't need it anymore
Set gobjCall = Nothing
Set objCallStateEvent = Nothing
Set pEvent = Nothing
Exit Sub
End If
'release all objects that aren't needed anymore
'it is important to release also the received pEvent
Set objCallStateEvent = Nothing
Set pEvent = Nothing
Exit Sub
End Sub
Private Sub pbDial_Click(index As Integer)
Dim bVideoIn As Boolean, bVideoOut As Boolean
Dim objTerminalAudioIn As Terminal, objTerminalAudioOut As Terminal
Dim objTerminalVideoIn As Terminal, objTerminalVideoOut As Terminal
Dim nOrigAddressIndex As Long
Dim strDestAddress As String
'second call not supported by this app
If Not (gobjCall Is Nothing) Then
lblStatus.Caption = "Cannot connect new call. Wait for the previous one to be disconnected."
Exit Sub
End If
'check if user typed input data
strDestAddress = txtDestAddress.Text
If strDestAddress = "" Then
lblStatus.Caption = "Enter destination addres!"
Exit Sub
End If
'global variables might already contain something, from previous run
If gobjTapi Is Nothing Then
'create the Tapi object
Set gobjTapi = CreateObject("TAPI.TAPI.1")
'call Initialize. this must be called before
'any other tapi functions are called.
gobjTapi.Initialize
End If
'pick up the collection of Address objects
Dim objCollAddresses As ITCollection
Set objCollAddresses = gobjTapi.Addresses
'find address that supports the desired type (the one selected in combo)
nOrigAddressIndex = FindOriginationAddressIndex(objCollAddresses)
'validate the returned value
If nOrigAddressIndex < 1 Or nOrigAddressIndex > objCollAddresses.Count Then
lblStatus.Caption = "Could not find an appropriate address to make the call from."
'release not needed objects
Set objCollAddresses = Nothing
Exit Sub
End If
'
'pick up the found address
'
If gnPreviousAddressIndex <> nOrigAddressIndex Then
'If another address was selected, release the previous one
'and save a "pointer" to the new one.
'If the same address was selected, don't release/save it again,
'just keep the previous one.
'release previous objects
Set gobjAddressWithEvents = Nothing
Set gobjOrigAddress = Nothing
'save new address
Set gobjOrigAddress = objCollAddresses.Item(nOrigAddressIndex)
'can't register the outgoing interface here, we'll do it
'later, after RegisterCallTypes;
'so, for now, leave empty the variable gobjAddressWithEvents
'save also the new index
gnPreviousAddressIndex = nOrigAddressIndex
End If
'release objects that are not needed anymore
'(this decrements the reference count)
Set objCollAddresses = Nothing
'
'find out if media types video in/out are supported as well
'
Dim objMediaSupport As ITMediaSupport
'query ITMediaSupport interface from Address object
Set objMediaSupport = gobjOrigAddress
'find out if video is supported
bVideoIn = False
bVideoOut = False
If objMediaSupport.QueryMediaType(TAPIMEDIATYPE_String_VideoIn) Then
bVideoIn = True
End If
If objMediaSupport.QueryMediaType(TAPIMEDIATYPE_String_VideoOut) Then
'Temporary: TBD: the null terminal causes a bug, so refuse it:
'If there is no static terminal for video out,
'better don't use the Null terminal, instead consider video out
'as being not supported.
Dim objTerminalSupport As ITTerminalSupport
Set objTerminalSupport = gobjOrigAddress
Set objTerminalVideoOut = objTerminalSupport.GetDefaultTerminal(TAPIMEDIATYPE_String_VideoOut)
Set objTerminalSupport = Nothing
If Not (objTerminalVideoOut Is Nothing) Then
bVideoOut = True
End If
Set objTerminalVideoOut = Nothing
End If
'release not needed objects
Set objMediaSupport = Nothing
'
'pick up the default terminal for each media type (except for VideoIn, which
'needs a dynamic "video window" terminal to be created)
'
'Dim objTerminalSupport As ITTerminalSupport TBD: when bug fixed, decomment this
'query ITTerminalSupport from Address object
Set objTerminalSupport = gobjOrigAddress
Set objTerminalAudioIn = objTerminalSupport.GetDefaultTerminal(TAPIMEDIATYPE_String_AudioIn)
Set objTerminalAudioOut = objTerminalSupport.GetDefaultTerminal(TAPIMEDIATYPE_String_AudioOut)
If bVideoIn = True Then
Set objTerminalVideoIn = objTerminalSupport.CreateTerminal(CLSID_String_VideoWindowTerm)
End If
If bVideoOut = True Then
Set objTerminalVideoOut = objTerminalSupport.GetDefaultTerminal(TAPIMEDIATYPE_String_VideoOut)
End If
Set objTerminalSupport = Nothing
'
'create MediaTerminals then put them in array
'
Dim arrMediaTerminals() As ITMediaTerminal
If bVideoIn = False And bVideoOut = False Then
ReDim arrMediaTerminals(1 To 2) As ITMediaTerminal
ElseIf bVideoIn = True And bVideoOut = False Or bVideoIn = False And bVideoOut = True Then
ReDim arrMediaTerminals(1 To 3) As ITMediaTerminal
Else
ReDim arrMediaTerminals(1 To 4) As ITMediaTerminal
End If
Dim objMediaTerminal As ITMediaTerminal
Set objMediaTerminal = gobjTapi.CreateMediaTerminal( _
TAPIMEDIATYPE_String_AudioIn, objTerminalAudioIn)
Set arrMediaTerminals(1) = objMediaTerminal
Set objMediaTerminal = Nothing
Set objTerminalAudioIn = Nothing
Set objMediaTerminal = gobjTapi.CreateMediaTerminal( _
TAPIMEDIATYPE_String_AudioOut, objTerminalAudioOut)
Set arrMediaTerminals(2) = objMediaTerminal
Set objMediaTerminal = Nothing
Set objTerminalAudioOut = Nothing
If bVideoIn = True Then
Set objMediaTerminal = gobjTapi.CreateMediaTerminal( _
TAPIMEDIATYPE_String_VideoIn, objTerminalVideoIn)
Set arrMediaTerminals(3) = objMediaTerminal
Set objMediaTerminal = Nothing
Set objTerminalVideoIn = Nothing
End If
If bVideoOut = True Then
Set objMediaTerminal = gobjTapi.CreateMediaTerminal( _
TAPIMEDIATYPE_String_VideoOut, objTerminalVideoOut)
If bVideoIn = True Then
Set arrMediaTerminals(4) = objMediaTerminal
Else
Set arrMediaTerminals(3) = objMediaTerminal
End If
Set objMediaTerminal = Nothing
Set objTerminalVideoOut = Nothing
End If
'
'register for receiving events: call RegisterCallTypes, then
'register the outgoing interface. This tells Tapi what type of events
'you want to receive, and for what media types; use the
'same media types that are used for making the call
'
If gobjAddressWithEvents Is Nothing Then
'this variable will contain Nothing only if address was changed;
'if it already contains a value, it means the address did not change,
'so there is no need to register the outgoing interface again.
'bOutgoing must be set on True in order to receive call state events
'for calls that the application owns
Dim bOutgoing, bOwner, bMonitor
bOutgoing = True
bOwner = False 'this is for receiving incoming calls
bMonitor = False 'this is for monitoring calls on the address
'put media type in array, then put array in a variant,
'as required by RegisterCallTypes
Dim arrMediaTypes() As String
If bVideoIn = False And bVideoOut = False Then
ReDim arrMediaTypes(1 To 2) As String
ElseIf bVideoIn = True And bVideoOut = False Or bVideoIn = False And bVideoOut = True Then
ReDim arrMediaTypes(1 To 3) As String
Else
ReDim arrMediaTypes(1 To 4) As String
End If
Dim MediaTypes As Variant
arrMediaTypes(1) = TAPIMEDIATYPE_String_AudioIn
arrMediaTypes(2) = TAPIMEDIATYPE_String_AudioOut
If bVideoIn = True Then
arrMediaTypes(3) = TAPIMEDIATYPE_String_VideoIn
End If
If bVideoOut = True Then
If bVideoIn = True Then
arrMediaTypes(4) = TAPIMEDIATYPE_String_VideoOut
Else
arrMediaTypes(3) = TAPIMEDIATYPE_String_VideoOut
End If
End If
MediaTypes = arrMediaTypes
Call gobjOrigAddress.RegisterCallTypes(bOutgoing, bOwner, bMonitor, MediaTypes)
'
'register the outgoing interface that will receive the events
'
Set gobjAddressWithEvents = gobjOrigAddress
End If
'
'create the call
'
Set gobjCall = gobjOrigAddress.CreateCall(strDestAddress)
'put the array of media terminals in a variant
Dim MediaTerminals As Variant
MediaTerminals = arrMediaTerminals
'
'select on the call the MediaTerminal
'
gobjCall.SelectMediaTerminals (MediaTerminals)
'release media terminals
Set arrMediaTerminals(1) = Nothing
Set arrMediaTerminals(2) = Nothing
Set MediaTerminals(1) = Nothing
Set MediaTerminals(2) = Nothing
If bVideoIn = True Or bVideoOut = True Then
Set arrMediaTerminals(3) = Nothing
Set MediaTerminals(3) = Nothing
End If
If bVideoIn = True And bVideoOut = True Then
Set arrMediaTerminals(4) = Nothing
Set MediaTerminals(4) = Nothing
End If
'
'Connect the call; False means that the call is made asynchronously.
'The call to Connect will return immediately, before the call
'gets to "connected" state; events will fire each time the
'state of the call changes (to "connected", "disconnected"),
'meanwhile the application can go on.
'
On Error Resume Next
gobjCall.Connect (False)
If Err.Number <> 0 Then
lblStatus.Caption = "Connect failed."
Err.Clear
'don't need this failed call anymore
Set gobjCall = Nothing
End If
End Sub
Private Sub pbDisconnect_Click(index As Integer)
If gobjCall Is Nothing Then
lblStatus.Caption = "There is no call to be disconnected."
Exit Sub
End If
gobjCall.Disconnect (DC_NORMAL)
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 the media types "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 FindOriginationAddressIndex(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 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 the media types "audio in" and "audio out"
'
bFound = False
For indexAddr = 1 To objCollAddresses.Count
Set objCrtAddress = objCollAddresses.Item(indexAddr)
Set objMediaSupport = objCrtAddress
If (objMediaSupport.QueryMediaType(TAPIMEDIATYPE_String_AudioIn) And _
objMediaSupport.QueryMediaType(TAPIMEDIATYPE_String_AudioOut)) 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 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
FindOriginationAddressIndex = indexAddr
Else
FindOriginationAddressIndex = 0
End If
Exit Function
End Function