tapiline.cls

用VB进行TAPI开发的源程.没有太详细的说明.有兴趣的同志得仔细看了.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CvbTAPILine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'****************************************************************
'*  VB file:   TAPILine.cls... VB32 wrapper for MS TAPI LINE API
'*
'*  created:        1999 by Ray Mercer
'*
'*  last modified:  8/25/99 by Ray Mercer
'*
'*
'*  Copyright (C) 1999 Ray Mercer.  All rights reserved.
'*  Latest version at http://i.am/shrinkwrapvb
'****************************************************************

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
                                    (dest As Any, src As Any, ByVal length As Long)

'DrawIconEx Constants
Private Const DI_MASK          As Long = &H1
Private Const DI_IMAGE         As Long = &H2
Private Const DI_NORMAL        As Long = &H3
Private Const DI_COMPAT        As Long = &H4
Private Const DI_DEFAULTSIZE   As Long = &H8
Private Declare Function DrawIconEx Lib "user32.dll" _
                            (ByVal hdc As Long, ByVal left As Long, ByVal top As Long, ByVal hIcon As Long, _
                            ByVal width As Long, ByVal height As Long, ByVal step As Long, ByVal hBrush As Long, _
                            ByVal uFlags As Long) As Long
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long  'BOOL

'Initialization, error & version control variables
Private m_hLineApp As Long 'handle to TAPI
Private m_APIversions() As Long
Private m_ExtAPIversions() As LINEEXTENSIONID
Private m_ApplicationVersion As Long 'some TAPI calls need this instead of negotiated API version
Private m_LowAPI As Long 'default TAPI 1.3 (&H00010003)
Private m_HiAPI As Long 'deafult TAPI 3.0 (&H00030000)
Private m_LastTAPIError As Long

'line selection variables
Private m_numLines As Long
Private m_CurLineID As Long

'devcaps variables
Private m_linecaps As LINEDEVCAPS
Private m_LineName As String
Private m_ProviderInfo As String
Private m_SwitchInfo As String
Private m_PermanentLineID As Long
Private m_StringFormat As Long
Private m_numAddresses As Long
Private m_maxDataRate As Long
Private m_BearerModes As Long
Private m_AddressModes As Long
Private m_MediaModes As Long
Private m_GenerateToneMaxNumFreq As Long
Private m_GenerateToneModes As Long
Private m_numTerminals As Long

'Call-state and asynch function state variables
Private m_hLine As Long
Private m_hCall As Long
Private m_RequestingCall As Long
Private m_DroppingCall As Long
Private m_ReqPrivileges As Long
Private m_ReqMediaModes As Long

'Events
Event MakeCallResult(ByVal errorCode As Long)
Event DropCallResult(ByVal errorCode As Long)
Event Connected()
Event Idle()
Event Disconnected()

Private Sub Class_Initialize()
    Debug.Print "class init"
    'default TAPI 1.3 - 3.0
    m_LowAPI = &H10003
    m_HiAPI = &H30000
End Sub
Public Property Get LowAPI() As Long
    LowAPI = m_LowAPI
End Property
Public Property Let LowAPI(ByVal ver As Long)
    m_LowAPI = ver
End Property

Public Property Get HiAPI() As Long
    HiAPI = m_HiAPI
End Property
Public Property Let HiAPI(ByVal ver As Long)
    m_HiAPI = ver
End Property


Public Property Get LastError() As Long
    LastError = m_LastTAPIError
    'reset error value after access
    m_LastTAPIError = 0&
End Property

Public Function ErrorString(ByVal errCode As Long) As String
    ErrorString = GetLineErrString(errCode)
End Function

Public Function Create() As Boolean

    Dim rc As Long
    Dim line As Long
    Dim lip As LINEINITIALIZEEXPARAMS
    Dim lxid As LINEEXTENSIONID
    
    'init params
    lip.dwTotalSize = Len(lip)
    lip.dwOptions = LINEINITIALIZEEXOPTION_USEHIDDENWINDOW
    
    'initialize TAPI lines and get handle
    rc = lineInitializeEx(m_hLineApp, App.hInstance, AddressOf mTAPIvb.LineCallbackProc, App.Title, _
                                m_numLines, m_HiAPI, lip)
    If rc <> TAPI_SUCCESS Then
        m_LastTAPIError = rc
        Exit Function
    Else
        If m_numLines < 1 Then Exit Function 'no lines!
        'negotiate and cache API versions for each line
        ReDim m_APIversions(0 To m_numLines - 1)
        ReDim m_ExtAPIversions(0 To m_numLines - 1)
        For line = 0 To m_numLines - 1
            rc = lineNegotiateAPIVersion(m_hLineApp, line, m_LowAPI, m_HiAPI, m_APIversions(line), lxid)
            If rc <> TAPI_SUCCESS Then
                m_APIversions(line) = 0 'no compatible API negotiated for this line
                rc = 0
            Else
                'also cache extension version (dev-specific features) if available
                m_ExtAPIversions(line).dwExtensionID0 = lxid.dwExtensionID0
                m_ExtAPIversions(line).dwExtensionID1 = lxid.dwExtensionID1
                m_ExtAPIversions(line).dwExtensionID2 = lxid.dwExtensionID2
                m_ExtAPIversions(line).dwExtensionID3 = lxid.dwExtensionID3
                'TODO! add call to lineNegotiateExtVersion()
                'and save the highest negotiated version as our app version
                If m_APIversions(line) > m_ApplicationVersion Then
                    m_ApplicationVersion = m_APIversions(line)
                End If
            End If
                
        Next
    End If
    rc = GetLineDevCaps()
    Create = True 'return success

End Function

Public Property Get numLines() As Long
    numLines = m_numLines
End Property

Public Property Get CurrentLineID() As Long
    CurrentLineID = m_CurLineID
End Property

Public Property Let CurrentLineID(ByVal id As Long)
    If id < 0 Then Err.Raise 380
    If id > m_numLines - 1 Then Err.Raise 380
    
    m_CurLineID = id
    Call GetLineDevCaps
    
End Property

Public Property Get NegotiatedAPIVersion() As Long
    NegotiatedAPIVersion = m_APIversions(m_CurLineID)
End Property

Public Property Get ExtAPI_ID0() As Long
   ExtAPI_ID0 = m_ExtAPIversions(m_CurLineID).dwExtensionID0
End Property

Public Property Get ExtAPI_ID1() As Long
   ExtAPI_ID1 = m_ExtAPIversions(m_CurLineID).dwExtensionID1
End Property

Public Property Get ExtAPI_ID2() As Long
   ExtAPI_ID2 = m_ExtAPIversions(m_CurLineID).dwExtensionID2
End Property

Public Property Get ExtAPI_ID3() As Long
   ExtAPI_ID3 = m_ExtAPIversions(m_CurLineID).dwExtensionID3
End Property

Private Function GetLineDevCaps() As Boolean
    Dim rc As Long
    
    'init required fields in devcaps UDT
    m_linecaps.dwTotalSize = Len(m_linecaps)
    
    'the LINEDEVCAPS UDT is just hard-allocated to be big enough to hold most
    'variable-length structures that TAPI may throw at you
    'if there is a better way from VB, I'd like to know (besides a Byte-array that is)...
    
    'request TAPI to fill UDT with info
    rc = lineGetDevCaps(m_hLineApp, m_CurLineID, m_APIversions(m_CurLineID), _
                        0&, m_linecaps)
    If rc <> TAPI_SUCCESS Then
        m_LastTAPIError = rc
        Exit Function
    End If
    
    'store UDT info in class local variables
    m_LineName = GetTAPIStructString(VarPtr(m_linecaps), m_linecaps.dwLineNameOffset, m_linecaps.dwLineNameSize)
    m_ProviderInfo = GetTAPIStructString(VarPtr(m_linecaps), m_linecaps.dwProviderInfoOffset, m_linecaps.dwProviderInfoSize)
    m_SwitchInfo = GetTAPIStructString(VarPtr(m_linecaps), m_linecaps.dwSwitchInfoOffset, m_linecaps.dwSwitchInfoSize)
    m_PermanentLineID = m_linecaps.dwPermanentLineID
    m_StringFormat = m_linecaps.dwStringFormat
    m_numAddresses = m_linecaps.dwNumAddresses
    m_maxDataRate = m_linecaps.dwMaxRate
    m_BearerModes = m_linecaps.dwBearerModes
    m_AddressModes = m_linecaps.dwAddressModes
    m_MediaModes = m_linecaps.dwMediaModes
    m_GenerateToneMaxNumFreq = m_linecaps.dwGenerateToneMaxNumFreq
    m_GenerateToneModes = m_linecaps.dwGenerateToneModes
    m_numTerminals = m_linecaps.dwNumTerminals
    
     'return success
    GetLineDevCaps = True
End Function
Public Property Get LineName() As String
    LineName = m_LineName
End Property
Public Property Get ProviderInfo() As String
    ProviderInfo = m_ProviderInfo
End Property
Public Property Get SwitchInfo() As String
    SwitchInfo = m_SwitchInfo
End Property
Public Property Get PermanentLineID() As Long
    PermanentLineID = m_PermanentLineID
End Property

Public Property Get StringFormat() As Long
    StringFormat = m_StringFormat
End Property
Public Property Get numAddresses() As Long
    numAddresses = m_numAddresses
End Property

Public Property Get maxDataRate() As Long
    maxDataRate = m_maxDataRate
End Property
Public Property Get BearerModes() As Long
    BearerModes = m_BearerModes
End Property
Public Property Get AddressModes() As Long
    AddressModes = m_AddressModes
End Property
Public Property Get mediamodes() As Long
    mediamodes = m_MediaModes
End Property
Public Property Get GenerateToneMaxNumFreq() As Long
    GenerateToneMaxNumFreq = m_GenerateToneMaxNumFreq
End Property
Public Property Get GenerateToneModes() As Long
    GenerateToneModes = m_GenerateToneModes
End Property
Public Property Get numTerminals() As Long
    numTerminals = m_numTerminals
End Property

Public Property Get LineSupportsVoiceCalls() As Boolean
    If m_BearerModes And LINEBEARERMODE_VOICE Then
        If m_MediaModes And LINEMEDIAMODE_INTERACTIVEVOICE Then
            LineSupportsVoiceCalls = True
        End If
    End If
End Property