📄 10-2.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "Modem 拨号实验程序"
ClientHeight = 5550
ClientLeft = 2670
ClientTop = 1725
ClientWidth = 4695
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5550
ScaleWidth = 4695
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin MSCommLib.MSComm Comm1
Left = 0
Top = 0
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
Handshaking = 2
RThreshold = 1
RTSEnable = -1 'True
End
Begin VB.CommandButton Command4
Caption = "测试"
Height = 375
Left = 120
TabIndex = 13
ToolTipText = "测试 Modem"
Top = 1320
Width = 855
End
Begin VB.Frame Frame2
Height = 495
Left = 120
TabIndex = 11
Top = 4920
Width = 4455
Begin VB.TextBox Status
Height = 270
Left = 720
TabIndex = 14
Top = 165
Width = 3615
End
Begin VB.Label Label3
Caption = "状态："
Height = 240
Left = 150
TabIndex = 12
Top = 210
Width = 735
End
End
Begin VB.CommandButton Command3
Caption = "挂断"
Height = 375
Left = 2400
TabIndex = 10
ToolTipText = "挂断电话"
Top = 1320
Width = 975
End
Begin VB.CommandButton Command2
Caption = "发送"
Height = 375
Left = 3600
TabIndex = 9
ToolTipText = "发送信息框中的文本"
Top = 1320
Width = 975
End
Begin VB.TextBox Command
Height = 270
Left = 1320
TabIndex = 7
Top = 960
Width = 3255
End
Begin VB.TextBox Text2
Height = 3135
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 6
Top = 1800
Width = 4455
End
Begin VB.TextBox Text1
Height = 270
Left = 1320
TabIndex = 4
Text = "169"
Top = 585
Width = 3255
End
Begin VB.CommandButton Command1
Caption = "拨号"
Height = 375
Left = 1200
TabIndex = 3
ToolTipText = "应用上述号码拨号"
Top = 1320
Width = 975
End
Begin VB.Frame Frame1
Height = 495
Left = 120
TabIndex = 0
Top = 0
Width = 4455
Begin VB.OptionButton T
Caption = "音频拨号（&T）"
Height = 180
Left = 2520
TabIndex = 2
Top = 240
Value = -1 'True
Width = 1575
End
Begin VB.OptionButton P
Caption = "脉冲拨号（&P）"
Height = 180
Left = 240
TabIndex = 1
Top = 240
Width = 1695
End
End
Begin VB.Label Label2
Caption = "信息："
Height = 255
Left = 480
TabIndex = 8
Top = 960
Width = 615
End
Begin VB.Label Label1
Caption = "电话号码："
Height = 255
Left = 240
TabIndex = 5
Top = 660
Width = 975
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ErrorCode As Integer
Dim LinkString As String
Private Function Waiting(Strings As String, WaitTime As Single) As String
Dim EndTime As Single
Dim Buffer As String
'计算结束时间
EndTime = Timer + WaitTime
'初始化数据
ErrorCode = 0
Do
DoEvents '处理其它事件
If Comm1.InBufferCount Then
'接收数据
Buffer = Buffer + Comm1.Input
If InStr(1, Buffer, Strings) Then
'接收到等待的字符串
Exit Do
End If
End If
If Timer >= EndTime Or ErrorCode Then
'等待超时
ErrorCode = 1
Exit Do
End If
Loop
'返回接收的字符串
Waiting = Buffer
End Function
Private Sub Comm1_OnComm()
Static Buffer As String
Select Case Comm1.CommEvent
' Handle each event or error by placing
' code below each case statement
' 错误
Case comEventBreak ' 收到 Break。
Case comEventCDTO ' CD (RLSD) 超时。
Case comEventCTSTO ' CTS 超时。
Case comEventDSRTO ' DSR 超时。
Case comEventFrame ' 贞错误
Case comEventOverrun '数据丢失。
Case comEventRxOver '接收缓冲区溢出。
Case comEventRxParity ' 校验错误。
Case comEventTxFull '传输缓冲区已满。
Case comEventDCB '获取 DCB 时意外错误
' 事件
Case comEvCD ' CD（载波） 线状态变化。
If Comm1.CDHolding Then
Status = "检测到载波信号"
Else
Status = "载波结束"
End If
Case comEvReceive ' 收到多于 RThreshold 属性设置的字符数（RThreshold 属性必须大于 0）。
Status = "收到" + Str(Comm1.InBufferCount) + "个字符"
Buffer = Buffer + Comm1.Input
If InStr(1, Buffer, "RING", vbTextCompare) Then
'收到镇铃
Comm1.Output = "ATA" + Chr(13) '命令 Modem 摘机响应
Buffer = "" '清缓冲区字符
Status = "收到震铃"
ElseIf InStr(1, Buffer, "CONNECT", vbTextCompare) Then
'对方应答呼叫
Buffer = "" '清缓冲区字符
Status = "已经建立连接"
ElseIf InStr(1, Buffer, "BUSY", vbTextCompare) Then
'对方线路忙
Buffer = "" '清缓冲区字符
Status = "对方线路忙"
ElseIf InStr(1, Buffer, "No Dialtone", vbTextCompare) Then
Buffer = "" '清缓冲区字符
Status = "拨出号码错"
ElseIf InStr(1, Buffer, "No Carrier", vbTextCompare) Then
'对方未摘机或未响应
Buffer = "" '清缓冲区字符
Status = "对方未摘机"
Else
Text2 = Buffer
End If
End Select
End Sub
Private Sub Command1_Click()
If Len(Text1) > 0 Then
If T.Value Then
LinkString = "ATDT" + Text1 '双音频拨号
Else
LinkString = "ATDP" + Text1 '脉冲拨号
End If
'开始拨号
Comm1.Output = LinkString + Chr(13)
End If
End Sub
Private Sub Command2_Click()
'发送信息框中的文本
Comm1.Output = Command.Text + Chr(13)
'Chr(13) 为换行符,表示一行的结束
'Modem只有接收到 Chr(13) 字符,才发送信息
End Sub
Private Sub Command3_Click()
'Modem 挂机
Comm1.Output = "+++ATH0" + Chr(13)
End Sub
Private Sub Command4_Click()
Dim Wait As String
'测试 Modem
Comm1.RThreshold = 0 '收到数据时禁止触发OnComm事件
Comm1.Output = "AT" + Chr(13)
Wait = Waiting("OK", 1)
If ErrorCode Then
'初始化 Modem 错
MsgBox "Modem 未准备好！", , "错误"
Else
Comm1.RThreshold = 1 '控件收到数据时将触发OnComm事件
End If
End Sub
Private Sub Form_Load()
Comm1.PortOpen = True '打开串口
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Comm1.PortOpen Then
'端口已经打开,关闭该端口
Comm1.PortOpen = False
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -