📄 main.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{3B00B10A-6EF0-11D1-A6AA-0020AFE4DE54}#1.0#0"; "Mp3play.ocx"
Begin VB.Form mainForm
BorderStyle = 1 'Fixed Single
Caption = "modem 语音实例"
ClientHeight = 7410
ClientLeft = 45
ClientTop = 330
ClientWidth = 8670
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7410
ScaleWidth = 8670
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame3
Caption = "语音操作"
Height = 5895
Left = 0
TabIndex = 11
Top = 1440
Width = 8655
Begin VB.CommandButton Command1
Caption = "挂断"
Height = 255
Left = 4680
TabIndex = 18
Top = 480
Width = 735
End
Begin MPEGPLAYLib.Mp3Play Mp3Play1
Height = 495
Left = 6360
TabIndex = 17
Top = 360
Visible = 0 'False
Width = 615
_Version = 65536
_ExtentX = 1085
_ExtentY = 873
_StockProps = 0
End
Begin VB.TextBox resultText
Height = 4935
Left = 120
MultiLine = -1 'True
TabIndex = 16
Top = 840
Width = 8415
End
Begin VB.CommandButton Command3
Caption = "接听"
Height = 255
Left = 3960
TabIndex = 15
Top = 480
Width = 615
End
Begin VB.CommandButton Command2
Caption = "拨打"
Height = 255
Left = 3240
TabIndex = 13
Top = 480
Width = 615
End
Begin VB.TextBox telnumber
Height = 270
Left = 600
TabIndex = 12
Top = 480
Width = 2535
End
Begin VB.Label Label4
Caption = "号码"
Height = 375
Left = 120
TabIndex = 14
Top = 480
Width = 615
End
End
Begin VB.Frame Frame1
Caption = "短信设备连接"
Height = 1305
Left = 0
TabIndex = 0
Top = 0
Width = 8625
Begin VB.Timer viewresutTimer
Enabled = 0 'False
Interval = 100
Left = 6240
Top = 840
End
Begin VB.Timer runatTimer
Enabled = 0 'False
Interval = 2000
Left = 5640
Top = 840
End
Begin MSCommLib.MSComm MSComm1
Left = 3480
Top = 720
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.CommandButton cmdDisConnect
Caption = "断开"
Enabled = 0 'False
Height = 300
Left = 6600
TabIndex = 5
Top = 480
Width = 615
End
Begin VB.CommandButton cmdConnect
Caption = "连接"
Height = 300
Left = 5880
TabIndex = 4
Top = 480
Width = 615
End
Begin VB.TextBox txtCommPort
Height = 300
Left = 4920
TabIndex = 3
Text = "1"
Top = 480
Width = 855
End
Begin VB.TextBox txtMsgCenter
Height = 300
Left = 1320
TabIndex = 2
Text = "+8613800755500"
Top = 480
Width = 1455
End
Begin VB.ComboBox cmbBaud
Height = 300
ItemData = "main.frx":0000
Left = 3360
List = "main.frx":001C
TabIndex = 1
Text = "9600"
Top = 480
Width = 1095
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Height = 255
Left = 4680
TabIndex = 10
Top = 960
Width = 3375
End
Begin VB.Label Label6
Caption = "端口"
Height = 255
Left = 4440
TabIndex = 9
Top = 480
Width = 495
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "短信中心号码："
Height = 255
Index = 4
Left = 120
TabIndex = 8
Top = 480
Width = 1260
End
Begin VB.Label Label9
Caption = "波特率"
Height = 255
Left = 2760
TabIndex = 7
Top = 480
Width = 615
End
Begin VB.Label Label10
Caption = "注：如果连接没反映请换波特率试一下"
Height = 255
Left = 120
TabIndex = 6
Top = 960
Width = 3135
End
End
End
Attribute VB_Name = "mainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public openstate As Boolean
Public OnCommstr As String 'OnComm事件里所接受的当前字符
Dim atcommandstr As String '保存所有的要执行的at指令
Dim resultstr As String '保存返回结果
Dim ringresultstr As String '保存返回结果,用来接听电话的
Private Sub cmdConnect_Click()
'On Error Resume Next
If txtMsgCenter.Text = "" Then
MsgBox ("请输入短信服务中心号码")
Exit Sub
End If
If txtCommPort.Text = "" Then
MsgBox ("请输入串口号")
Exit Sub
End If
If cmbBaud.Text = "" Then
MsgBox ("请输入波特率")
Exit Sub
End If
If Not (IsNumeric(cmbBaud.Text)) Then
MsgBox ("波特率必须为数字")
Exit Sub
End If
If Not (IsNumeric(txtCommPort.Text)) Then
MsgBox ("串口号必须为数字")
Exit Sub
End If
MSComm1.CommPort = Int(txtCommPort.Text) ';//选择COM1(1-COM1，2-COM2……)打开端口之前设置 CommPort 属性，这里容易出错
MSComm1.InBufferSize = 1024 ';//设置接受缓冲区为1024字节
MSComm1.OutBufferSize = 512 ';//设置发送缓冲区为512字节
MSComm1.InBufferCount = 0 ';//清除接收缓冲区
MSComm1.OutBufferCount = 0 ';//清除发送缓冲区
MSComm1.RTSEnable = True '; //请求发送
MSComm1.RThreshold = 1 ';//设置为接收缓冲区每接收一个字符将引发一次OnComm事件
MSComm1.DTREnable = True '; // 数据终端准备好
MSComm1.Handshaking = comNone
MSComm1.Settings = CStr(cmbBaud.Text) & ",N,8,1" ';//设置波特率无校验，8个数据位，1个停止位
MSComm1.PortOpen = True
If MSComm1.PortOpen = True Then
atcommandstr = atcommandstr & "AT+CMGF=0" & vbCr & "," '切换到pdu格式,否则将读出短信时出错
atcommandstr = atcommandstr & "AT+CSCA=" & txtMsgCenter.Text & vbCr & "," '设置短信中心服务号码
cmdConnect.Enabled = False
cmdDisConnect.Enabled = True
openstate = True
runatTimer.Enabled = True
Else
MsgBox ("连接失败，看端口有没设置正确")
openstate = False
runatTimer.Enabled = False
End If
End Sub
Private Sub cmdDisConnect_Click()
Call dk
End Sub
Sub dk() '断开操作
On Error Resume Next
MSComm1.PortOpen = False
cmdConnect.Enabled = True
cmdDisConnect.Enabled = False
openstate = False
runatTimer.Enabled = False
End Sub
Sub ts(str As String)
Label3.Caption = str
End Sub
Private Sub Command1_Click()
If openstate = True Then
MSComm1.Output = "ATH" & vbCr
Else
ts ("设备未连接")
End If
End Sub
Private Sub Command2_Click()
If telnumber.Text = "" Then
MsgBox ("请输入电话号码")
Exit Sub
End If
If openstate = True Then
atcommandstr = atcommandstr & "ATD<" & telnumber.Text & ">" & vbCr & ","
Else
ts ("设备未连接")
End If
End Sub
Private Sub Command3_Click()
If openstate = True Then
atcommandstr = atcommandstr & "ATA" & vbCr & ","
Else
ts ("设备未连接")
End If
End Sub
Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
Case comEventBreak ' 收到 Break。
ts ("接收到一个中断信号")
Case comEventCDTO ' CD (RLSD) 超时。
ts ("载波检测超时。在系统规定时间内传输一个字符时，Carrier Detect 线为低电平。Carrier Detect 也称为 Receive Line Signal Detect (RLSD)。")
Case comEventCTSTO ' CTS Timeout。
ts ("Clear To Send 超时。在系统规定时间内传输一个字符时，Clear To Send 线为低电平。")
Case comEventDSRTO ' DSR Timeout。
ts ("Data Set Ready 超时。在系统规定时间内传输一个字符时，Data Set Ready 线为低电平。")
Case comEventFrame ' Framing Error
ts ("帧错误。硬件检测到一帧错误")
Case comEventOverrun '数据丢失。
ts ("端口超速。没有在下一个字符到达之前从硬件读取字符，该字符丢失。")
Case comEventRxOver '接收缓冲区溢出。
ts ("接受缓冲区溢出。接收缓冲区没有空间。")
Case comEventRxParity ' Parity 错误。
ts ("奇偶校验。硬件检测到奇偶校验错误")
Case comEventTxFull '传输缓冲区已满。
ts ("传输缓冲区已满。传输字符时传输缓冲区已满")
Case comEventDCB '获取 DCB] 时意外错误
ts ("检索端口的设备控制块 (DCB) 时的意外错误")
' 事件
Case comEvCD ' CD 线状态变化。
'ts ("Carrier Detect 线的状态发生变化。")
dk
Case comEvCTS ' CTS 线状态变化。
'ts ("Clear To Send 线的状态发生变化。")
dk
Case comEvDSR ' DSR 线状态变化。
'ts ("Data Set Ready 线的状态发生变化。该事件只在 DST 从 1 变到 0 时才发生。")
dk
Case comEvRing ' Ring Indicator 变化。
'ts ("检测到振铃信号。一些 UART（通用异步接收— 传输）可能不支持该事件。")
Case comEvReceive ' 收到 RThreshold # of
'ts ("收到 Rthreshold 个字符。该事件将持续产生直到用 Input 属性从接收缓冲区中删除数据。")
OnCommstr = MSComm1.Input
resultText.Text = resultText.Text & OnCommstr 'OnCommstr是数量不等的字符串
resultstr = resultstr & OnCommstr
ringresultstr = ringresultstr & OnCommstr
If InStr(Right(ringresultstr, 6), "RING") <> 0 Then
playmp3
ringresultstr = ""
End If
Case comEvSend ' 传输缓冲区有 Sthreshold 个字符
ts ("在传输缓冲区中有比 Sthreshold 数少的字符。") '
Case comEvEOF ' 输入数据流中发现 EOF 字符
ts ("收到文件结束（ASCII 字符为 26）字符。") '
End Select
End Sub
Sub playmp3()
On Error GoTo error_handle
Mp3Play1.Open App.Path & "\" & "RING.mp3", ""
Mp3Play1.Play
Exit Sub
error_handle:
End Sub
Private Sub runatTimer_Timer()
If atcommandstr = "" Or openstate = False Then
Exit Sub
End If
Dim atcommandstrarray
atcommandstrarray = Split(atcommandstr, ",")
runatTimer.Enabled = False
MSComm1.Output = CStr(atcommandstrarray(0))
viewresutTimer.Enabled = True
End Sub
Private Sub viewresutTimer_Timer()
Dim atcommandstrarray
If Right(resultstr, 2) = vbCr & vbLf Then
If atcommandstr <> "" Then
atcommandstrarray = Split(atcommandstr, ",")
atcommandstr = Mid(atcommandstr, Len(atcommandstrarray(0)) + 2)
resultstr = ""
viewresutTimer.Enabled = False
runatTimer.Enabled = True
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -