用VB实现来电显示的源代码（部份）
下面的代码是我上次给一个上公司
做管理信息系统时用来实现来电显示的源代码。
发到这里时只删了一些没有用的东西
大家就凑合着看吧
有兴趣的话可以发信到sobigapple@qq.com和我交流
我是菜鸟
Option Explicit
Const DEBFLG = 1
Public COMX, BEEPNO, HANGUP, PNLOC As Integer
Public COMBUF, COMLIN As String
Dim h
Private Sub Command1_Click()
frmWelcome.Visible = False
End Sub
Private Sub Option1_Click(Index As Integer)
COMX = Index + 1
Call INIT_MODEM
End Sub
Private Sub Form_Load()
'电话号码置空
PhoneNumber = "" '用来存放从猫中的电话号码
getNumber = "" '存放去掉区号后的号码
With MSComm1
.InBufferSize = 1024
.InputLen = 0
.InputMode = 0
.RThreshold = 1
.RTSEnable = True
.Settings = "9600,N,8,1"
.SThreshold = 0
End With
'检测串行口
Dim I, C As Integer
COMX = 0
COMBUF = ""
COMLIN = ""
BEEPNO = 0
HANGUP = 0
On Error GoTo ERROR_FORM_LOAD
'检测可用串口
For C = 1 To 4
If MSComm1.PortOpen Then MSComm1.PortOpen = False
MSComm1.CommPort = C
If Not MSComm1.PortOpen Then
MSComm1.PortOpen = True
End If
If MSComm1.PortOpen Then MSComm1.PortOpen = False
If COMX = 0 Then COMX = C
FORM_LOAD_1:
Next C
If COMX = 0 Then End
On Error GoTo 0
Option1(COMX - 1).Value = True
Exit Sub
ERROR_FORM_LOAD:
Option1(C - 1).Enabled = False
Resume FORM_LOAD_1
Exit Sub
Exit Sub
why:
MsgBox Err.Description
End Sub
'检测串行口
'检查Modem命令是否完成
Private Sub CHK_MODEM()
On Error GoTo why
Dim T As Single
Dim L As Integer
T = Timer
Do
COMBUF = COMBUF + MSComm1.Input
L = InStr(1, COMBUF, "OK")
Loop Until L <> 0 Or Timer - T > 1
If L = 0 Then
MsgBox "端口" & COMX & "上没有发现Modem,请选择别的端口试试.", vbOKOnly + vbCritical, "测试MODEM"
Else
MsgBox "来电显示已经启动,确定此按钮后,如果返回ok,说明计算机与Modem能正常通信，否则,请重试其它端口"
End If
Exit Sub
why: MsgBox Err.Description
End Sub
'串行口接收事件处理
Private Sub MSComm1_OnComm()
Dim a
Dim b
On Error GoTo why
Dim inStrData As String, tm As String
Dim iPos As Integer
inStrData = MSComm1.Input & MSComm1.Input
iPos = InStr(inStrData, "NMBR=")
'记录程序是否第一次打开，不是话下次就不显示猫的返回信息
If TimeOpen = 0 Then
MsgBox inStrData
TimeOpen = 54 '写成什么都可以，但0不可以,
MsgBox "恭喜!来电显示和Modem都已经成功设置." '成功了，哈哈，我有钱可以赚了
frmWelcome.Visible = False
Command2.Visible = False
End If
a = InStr(1, inStrData, "NMBR = ", vbTextCompare)
If a <> 0 Then
b = InStr(a, inStrData, vbCr, vbTextCompare)
PhoneNumber = Mid(inStrData, a + 7, b - a - 7)
frmReg.Show
Else:
End If
Exit Sub
why:
MsgBox Err.Description
End Sub
Private Sub INIT_MODEM()
On Error GoTo why
If MSComm1.PortOpen Then MSComm1.PortOpen = False
MSComm1.CommPort = COMX
If Not MSComm1.PortOpen Then MSComm1.PortOpen = True
MSComm1.Output = "AT+VCID=1" + vbCr
'检查Modem命令是否完成
Call CHK_MODEM
MSComm1.Output = "ATS0=0" + vbCr
Exit Sub
why:
MsgBox Err.Description
End Sub
