设为首页收藏本站

SKY外语、计算机论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

楼主: fieldmax
打印 上一主题 下一主题

VB_来电显示的实现

[复制链接]

16

主题

0

好友

216

积分

中级会员

Rank: 3Rank: 3

生肖
性别

最佳新人 论坛元老

跳转到指定楼层
楼主
发表于 2012-4-28 21:46:51 |只看该作者 |倒序浏览
本帖最后由 fieldmax 于 2012-4-28 22:38 编辑

VB来电显示的实现

MODEM的AT命令CID和VCID是设置是不是来电显示的,如果电信开通了来电显示功能
就能通过MODEM来显示对方的电话号码。那么首先设置CID=1或是VCID=1

一般来说来电显示的信息为:

DATE = MMDD "来电日期 MMDD
TIME = HHMM "来电时间 HHMM
NMBR = ######## "来电号码

程序实现如下,设置MSComm1的相关设置,并建两个Label为Label1和Label2

  1. Function OpenCID(OpenCLose As Boolean) As Boolean
  2. '打开或是关毕来电显示功能
  3. On Error Resume Next
  4. Dim ArrCID(1) As String
  5.         ArrCID(0) = "at#cid=" & IIf(openclode, 1, 0)
  6.         ArrCID(1) = "at#vcid=" & IIf(openclode, 1, 0)
  7.         MSComm1.RThreshold = 0
  8.         For i = 0 To 1
  9.                 MSComm1.Output = ArrCID(i) & vbCr
  10.                 EndTime = Timer + 0.5
  11.                 Do While bStop = False
  12.                         nTemp = nTemp + 1
  13.                         If MSComm1.InBufferCount >= 2 Then
  14.                                 sTemp = MSComm1.Input
  15.                                 If InStr(sTemp, "OK") = 0 Then
  16.                                         bStop = True
  17.                                         OpenCID = True
  18.                                         Exit Function
  19.                                 End If
  20.                         End If
  21.                         If Timer >= EndTime Or ErrorCode Then Exit Do
  22.                 Loop
  23.         Next i
  24.         OpenCID = False
  25.         MSComm1.RThreshold = 1
  26. End Function
复制代码
下面的函数显示来电号码并在窗体上的Label1的Label2上显示出来

  1. Private Sub MSComm1_OnComm()
  2. On Error Resume Next
  3. Static Buffer As String
  4. ' 收到多于 RThreshold 属性设置的字符数(RThreshold 属性必须大于 0)。
  5. 'label1 = "收到" + Str(MSComm1.InBufferCount) + "个字符"
  6.         Buffer = Buffer + MSComm1.Input
  7.         Buffer = UCase(Buffer)

  8. ' Exit Sub
  9.         If InStr(1, Buffer, "RING", vbTextCompare) Then
  10.         '收到震铃
  11.                 'Comm1.Output = "ATA" + Chr(13) '命令 Modem 摘机响应
  12.                 Buffer = "" '清缓冲区字符
  13.                 'mciExecute "sound " & SystemPath & "\ringin.wav"
  14.                 Label1 = "状态:收到震铃"
  15.                 Zhen = True
  16.                 frmCallID.Show
  17.                 frmCallID.ChangRing


  18.         ElseIf InStr(1, Buffer, "CONNECT", vbTextCompare) Then
  19.         '对方应答呼叫
  20.                 Buffer = "" '清缓冲区字符
  21.                 Label1 = "状态:已经建立连接"
  22.         ElseIf InStr(1, Buffer, "BUSY", vbTextCompare) Then
  23.         '对方线路忙
  24.                 Buffer = "" '清缓冲区字符
  25.                 Label1 = "状态:对方线路忙"
  26.         ElseIf InStr(1, Buffer, "No DIA", vbTextCompare) Then
  27.                 Buffer = "" '清缓冲区字符
  28.                 Label1 = "状态:拨出号码错,请检查电话线"
  29.                 Command1_Click
  30.         ElseIf InStr(1, Buffer, "No CARRIER", vbTextCompare) Then
  31.         '对方未摘机或未响应
  32.                 Buffer = "" '清缓冲区字符
  33.                 Label1 = "状态:对方未摘机"

  34.         ElseIf InStr(1, Buffer, "NMBR =", vbTextCompare) Then
  35.                 tmpStr = InStr(1, Buffer, "NMBR", vbTextCompare)
  36.                 CallNum = Right(Buffer, Len(Buffer) - lll - 6)
  37.                 Label2.Caption = "对方电话:" + CallNum

  38.                 'Buffer = "" '清缓冲区字符
  39.         ElseIf InStr(1, Buffer, "OK", vbTextCompare) And Asc(Right(Buffer, 1)) = 10 Then
  40.                 If Zhen = False Then Buffer = "" '清缓冲区字符
  41.                 If Command1.Caption = "挂断" Then
  42.                         Label2.Caption = "状态:已经播通电话:" + txtCallNum
  43.                 End If
  44.         End If
  45. End Sub
复制代码
分享到: QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
分享淘帖0 收藏收藏0 评分评分

4

主题

2

好友

201

积分

中级会员

Rank: 3Rank: 3

生肖
星座
天蝎座
性别

最佳新人 活跃会员 论坛元老

沙发
发表于 2012-4-29 09:19:08 来自手机 |只看该作者
本帖最后由 sky_yx 于 2015-12-30 14:23 编辑

不'
错!可以借鉴

回复

使用道具 评分 举报

您需要登录后才可以回帖 登录 | 立即注册


手机版|SKY外语计算机学习 ( 粤ICP备12031577 )    

GMT+8, 2024-12-22 01:52 , Processed in 0.117579 second(s), 29 queries .

回顶部