### http://www.lawebdelprogramador.com/ ###
### RESPUESTA A LA PREGUNTA 3248 - VISUAL BASIC ###


Private Sub MSComm1_OnComm()
On Error GoTo Err_Rutina_Error
Dim conta As Long
    Dim EVMsg$
    Dim ERMsg$
    Select Case MSComm1.CommEvent
        Case comEvReceive
            Dim Buffer As Variant
        Case comEvSend
        Case comEvCTS
            EVMsg$ = "Detectado cambio en CTS"
        Case comEvDSR
            EVMsg$ = "Detectado cambio en DSR"
        Case comEvCD
            EVMsg$ = "Detectado cambio en CD"
        Case comEvRing
        Linea1 = 1
            Call CheckForCall 'Función busca el número
        Case comEvEOF
            EVMsg$ = "Detectado el final del archivo"
        Case comBreak
            ERMsg$ = "Parada recibida"
        Case comCDTO
            ERMsg$ = "Sobrepasado el tiempo de espera de detección de portadora"
        Case comCTSTO
            ERMsg$ = "Soprepasado el tiempo de espera de CTS"
        Case comDCB
            ERMsg$ = "Error recibiendo DCB"
        Case comDSRTO
            ERMsg$ = "Sobrepasado el tiempo de espera de DSR"
        Case comFrame
            ERMsg$ = "Error de marco"
        Case comOverrun
            ERMsg$ = "Error de sobrecarga"
        Case comRxOver
            ERMsg$ = "Desbordamiento en el búfer de recepción"
        Case comRxParity
            ERMsg$ = "Error de paridad"
        Case comTxFull
            ERMsg$ = "Búfer de transmisión lleno"
        Case Else
            ERMsg$ = "Error o evento desconocido"
    End Select
Exit_Rutina_Error:
    Exit Sub
Err_Rutina_Error:
    MsgBox Err.Description
    Resume Exit_Rutina_Error
End Sub

Sub CheckForCall()
On Error GoTo Err_Rutina_Error
Dim   sTemp1 As String,  nTemp As String, sNumber As String

       sTemp1 = Me.MSComm1.Input
        WriteCIDData (sTemp1)

Exit_Rutina_Error:
    Exit Sub
Err_Rutina_Error:
    MsgBox Err.Description
    Resume Exit_Rutina_Error
End Sub

Sub WriteCIDData(sInput As String)
On Error GoTo Err_Rutina_Error
Dim sName As String
Dim sNumber As String

sNumber = "?"
    If InStr(sInput, "MESG =") Then
        nTemp = InStr(sInput, "MESG =")
        sName = Mid(sInput, nTemp + 7)
        sNumber = "NO NUMBER SENT"
    Else
        nTemp = InStr(sInput, "NMBR =")
        If nTemp <> 0 Then sNumber = Mid(sInput, nTemp + 7, 17)
        sTemp1 = Val(sNumber) 'Left$(sNumber, 45)
        sTemp1 = Right$(sTemp1, 10)
        If sTemp1 <> 0 Then
            If Len(sTemp1) < 10 Then
                If Len(sTemp1) = 6 Then
                    sTemp1 = "8" + sTemp1
                ElseIf sTemp1 = 8 Then
                    sTemp1 = Right(sTemp1, 8)
                End If
                sTemp = sTemp1
                Criterio = "TELEF1 Like '" & sTemp1 & "'"
            Else
                sTemp = sTemp1
            End If
        End If
    End If
Exit_Rutina_Error:
    Exit Sub
Err_Rutina_Error:
    MsgBox Err.Description
    Resume Exit_Rutina_Error
End Sub


### JOSE PASTOR LEZCANO LOPEZ - josepastor.lezcano@telecom.com.co