来电显示.frm
上传用户:chinaplant
上传日期:2010-01-23
资源大小:2k
文件大小:4k
源码类别:

Modem编程

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
  3. Begin VB.Form Form1 
  4.    ClientHeight    =   3105
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   2940
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   3105
  10.    ScaleWidth      =   2940
  11.    StartUpPosition =   3  '窗口缺省
  12.    Begin MSCommLib.MSComm MSComm1 
  13.       Left            =   0
  14.       Top             =   0
  15.       _ExtentX        =   1005
  16.       _ExtentY        =   1005
  17.       _Version        =   393216
  18.       DTREnable       =   -1  'True
  19.    End
  20.    Begin VB.TextBox Text2 
  21.       Height          =   375
  22.       Left            =   120
  23.       TabIndex        =   1
  24.       Top             =   2520
  25.       Width           =   2655
  26.    End
  27.    Begin VB.Timer Timer1 
  28.       Interval        =   60
  29.       Left            =   6960
  30.       Top             =   2400
  31.    End
  32.    Begin VB.TextBox Text1 
  33.       Height          =   2295
  34.       Left            =   120
  35.       MultiLine       =   -1  'True
  36.       TabIndex        =   0
  37.       Top             =   120
  38.       Width           =   2655
  39.    End
  40. End
  41. Attribute VB_Name = "Form1"
  42. Attribute VB_GlobalNameSpace = False
  43. Attribute VB_Creatable = False
  44. Attribute VB_PredeclaredId = True
  45. Attribute VB_Exposed = False
  46. Option Explicit
  47. Public COMBUF, COMLIN As String
  48. Private Sub Form_Load()
  49.       call  Init_CallID()
  50. End Sub
  51. '****************************************************
  52. Private Function Init_CallID() As String
  53. '返回所有可用串行口
  54.     Dim C As Integer,L As Integer
  55.     Dim T As Single
  56.     On Error GoTo NotCOM
  57.     '检测可用串口
  58.     For C = 1 To 6
  59.         If MSComm1.PortOpen Then MSComm1.PortOpen = False
  60.         MSComm1.CommPort = C
  61.         If Not MSComm1.PortOpen Then MSComm1.PortOpen = True'没串口时出错并跳到NOTCOM标号
  62.         MSComm1.Output = "AT#CID=1" + vbCr                  '打开MODEM的
  63.         T = Timer
  64.         Do
  65.            COMBUF = COMBUF + MSComm1.Input
  66.            L = InStr(1, COMBUF, "OK")
  67.            if L<>0 them
  68.               MSComm1.Output = "ATS0=0" + vbCr
  69.               Exit Function       'GOTO NotCOM 用于初始化所有串口的MODEM,
  70.            end if
  71.         Loop Until  Timer - T > 1
  72. NotCOM:
  73.     Next C
  74.     If C = 4 Then MsgBox "没有可用串口!"
  75.     if L = 0 then msgbox "没有MODEM或MODEM不支持来电显示!"
  76. End Function
  77. Private Function INIT_MODEM(ByVal COMNUM As Long) As Long
  78. 'MODEM是否联接指定串口
  79.     Dim T As Single
  80.     Dim L As Integer
  81.     INIT_MODEM = 0
  82.     If MSComm1.PortOpen Then MSComm1.PortOpen = False
  83.     MSComm1.CommPort = COMNUM
  84.     If Not MSComm1.PortOpen Then MSComm1.PortOpen = True
  85.     MSComm1.Output = "AT#CID=1" + vbCr
  86.     T = Timer
  87.     Do
  88.         COMBUF = COMBUF + MSComm1.Input
  89.         L = InStr(1, COMBUF, "OK")
  90.     Loop Until L <> 0 Or Timer - T > 1
  91.     If L <> 0 Then
  92.         INIT_MODEM = 1
  93.     Else
  94.         Exit Function
  95.     End If
  96.     MSComm1.Output = "ATS0=0" + vbCr
  97. End Function
  98.    
  99. Private Sub MSComm1_OnComm()
  100. '串行口接收事件处理
  101.     Dim CH, ST As String
  102.     Dim LC As Integer
  103.     Select Case MSComm1.CommEvent
  104.     '接收到Rthreshold个字符
  105.     Case comEvReceive
  106.         COMBUF = COMBUF + MSComm1.Input
  107.         '读取串口数据
  108.         Do
  109.             LC = InStr(1, COMBUF, Chr(10))
  110.             If LC = 0 Then Exit Do
  111.             COMLIN = Left(COMBUF, LC)
  112.             COMBUF = Mid(COMBUF, LC + 1)
  113.             CH = Left(COMLIN, 1)
  114.             If "" < CH And CH < Chr(127) And DEBFLG = 1 Then
  115.                 Text1.Text = Text1.Text + COMLIN
  116.                 Text1.SelStart = Len(Text1.Text)
  117.             End If
  118.             '截取来电号码,并显示
  119.             If InStr(1, COMLIN, "NMBR = ") <> 0 Then
  120.                 ST = Mid(COMLIN, 8)
  121.                 Text2.Text = "" + Left$(ST, Len(ST) - 2) + " "
  122.             End If
  123.         Loop
  124.     End Select
  125. End Sub