来电显示的实现
MODEM的AT命令CID和VCID是设置是不是来电显示的,如果电信开通了来电显示功能
就能通过MODEM来显示对方的电话号码。那么首先设置CID=1或是VCID=1
般来说来电显示的信息为:
DATE = MMDD "来电日期 MMDD
TIME = HHMM "来电时间 HHMM
NMBR = ######## "来电号码
程序实现如下,设置MSComm1的相关设置,并建两个Label为Label1和Label2
Function
OpenCID(OpenCLose
As
Boolean
)
As
Boolean
' 打开或是关毕来电显示功能
On Error Resume Next
Dim ArrCID( 1 ) As String
ArrCID( 0 ) = " at#cid= " & IIf(openclode, 1 , 0 )
ArrCID( 1 ) = " at#vcid= " & IIf(openclode, 1 , 0 )
MSComm1.RThreshold = 0
For i = 0 To 1
MSComm1.Output = ArrCID(i) & vbCr
EndTime = Timer + 0.5
Do While bStop = False
nTemp = nTemp + 1
If MSComm1.InBufferCount >= 2 Then
sTemp = MSComm1.Input
If InStr (sTemp, " OK " ) = 0 Then
bStop = True
OpenCID = True
Exit Function
End If
End If
If Timer >= EndTime Or ErrorCode Then Exit Do
Loop
Next i
OpenCID = False
MSComm1.RThreshold = 1
End Function
' 打开或是关毕来电显示功能
On Error Resume Next
Dim ArrCID( 1 ) As String
ArrCID( 0 ) = " at#cid= " & IIf(openclode, 1 , 0 )
ArrCID( 1 ) = " at#vcid= " & IIf(openclode, 1 , 0 )
MSComm1.RThreshold = 0
For i = 0 To 1
MSComm1.Output = ArrCID(i) & vbCr
EndTime = Timer + 0.5
Do While bStop = False
nTemp = nTemp + 1
If MSComm1.InBufferCount >= 2 Then
sTemp = MSComm1.Input
If InStr (sTemp, " OK " ) = 0 Then
bStop = True
OpenCID = True
Exit Function
End If
End If
If Timer >= EndTime Or ErrorCode Then Exit Do
Loop
Next i
OpenCID = False
MSComm1.RThreshold = 1
End Function
下面的函数显示来电号码并在窗体上的Label1的Label2上显示出来
Private
Sub
MSComm1_OnComm()
On Error Resume Next
Static Buffer As String
' 收到多于 RThreshold 属性设置的字符数(RThreshold 属性必须大于 0)。
' label1 = "收到" + Str(MSComm1.InBufferCount) + "个字符"
Buffer = Buffer + MSComm1.Input
Buffer = UCase (Buffer)
' Exit Sub
If InStr ( 1 , Buffer, " RING " , vbTextCompare) Then
' 收到震铃
' Comm1.Output = "ATA" + Chr(13) '命令 Modem 摘机响应
Buffer = "" ' 清缓冲区字符
' mciExecute "sound " & SystemPath & " ingin.wav"
Label1 = " 状态:收到震铃 "
Zhen = True
frmCallID.Show
frmCallID.ChangRing
ElseIf InStr ( 1 , Buffer, " CONNECT " , vbTextCompare) Then
' 对方应答呼叫
Buffer = "" ' 清缓冲区字符
Label1 = " 状态:已经建立连接 "
ElseIf InStr ( 1 , Buffer, " BUSY " , vbTextCompare) Then
' 对方线路忙
Buffer = "" ' 清缓冲区字符
Label1 = " 状态:对方线路忙 "
ElseIf InStr ( 1 , Buffer, " No DIA " , vbTextCompare) Then
Buffer = "" ' 清缓冲区字符
Label1 = " 状态:拨出号码错,请检查电话线 "
Command1_Click
ElseIf InStr ( 1 , Buffer, " No CARRIER " , vbTextCompare) Then
' 对方未摘机或未响应
Buffer = "" ' 清缓冲区字符
Label1 = " 状态:对方未摘机 "
ElseIf InStr ( 1 , Buffer, " NMBR = " , vbTextCompare) Then
tmpStr = InStr ( 1 , Buffer, " NMBR " , vbTextCompare)
CallNum = Right (Buffer, Len (Buffer) - lll - 6 )
Label2.Caption = " 对方电话: " + CallNum
' Buffer = "" '清缓冲区字符
ElseIf InStr ( 1 , Buffer, " OK " , vbTextCompare) And Asc ( Right (Buffer, 1 )) = 10 Then
If Zhen = False Then Buffer = "" ' 清缓冲区字符
If Command1.Caption = " 挂断 " Then
Label2.Caption = " 状态:已经播通电话: " + txtCallNum
End If
End If
End Sub
On Error Resume Next
Static Buffer As String
' 收到多于 RThreshold 属性设置的字符数(RThreshold 属性必须大于 0)。
' label1 = "收到" + Str(MSComm1.InBufferCount) + "个字符"
Buffer = Buffer + MSComm1.Input
Buffer = UCase (Buffer)
' Exit Sub
If InStr ( 1 , Buffer, " RING " , vbTextCompare) Then
' 收到震铃
' Comm1.Output = "ATA" + Chr(13) '命令 Modem 摘机响应
Buffer = "" ' 清缓冲区字符
' mciExecute "sound " & SystemPath & " ingin.wav"
Label1 = " 状态:收到震铃 "
Zhen = True
frmCallID.Show
frmCallID.ChangRing
ElseIf InStr ( 1 , Buffer, " CONNECT " , vbTextCompare) Then
' 对方应答呼叫
Buffer = "" ' 清缓冲区字符
Label1 = " 状态:已经建立连接 "
ElseIf InStr ( 1 , Buffer, " BUSY " , vbTextCompare) Then
' 对方线路忙
Buffer = "" ' 清缓冲区字符
Label1 = " 状态:对方线路忙 "
ElseIf InStr ( 1 , Buffer, " No DIA " , vbTextCompare) Then
Buffer = "" ' 清缓冲区字符
Label1 = " 状态:拨出号码错,请检查电话线 "
Command1_Click
ElseIf InStr ( 1 , Buffer, " No CARRIER " , vbTextCompare) Then
' 对方未摘机或未响应
Buffer = "" ' 清缓冲区字符
Label1 = " 状态:对方未摘机 "
ElseIf InStr ( 1 , Buffer, " NMBR = " , vbTextCompare) Then
tmpStr = InStr ( 1 , Buffer, " NMBR " , vbTextCompare)
CallNum = Right (Buffer, Len (Buffer) - lll - 6 )
Label2.Caption = " 对方电话: " + CallNum
' Buffer = "" '清缓冲区字符
ElseIf InStr ( 1 , Buffer, " OK " , vbTextCompare) And Asc ( Right (Buffer, 1 )) = 10 Then
If Zhen = False Then Buffer = "" ' 清缓冲区字符
If Command1.Caption = " 挂断 " Then
Label2.Caption = " 状态:已经播通电话: " + txtCallNum
End If
End If
End Sub