📄 confrm.frm
字号:
VERSION 5.00
Begin VB.Form conFrm
Caption = "Form1"
ClientHeight = 3000
ClientLeft = 60
ClientTop = 465
ClientWidth = 4515
LinkTopic = "Form1"
ScaleHeight = 3000
ScaleWidth = 4515
StartUpPosition = 3 'Windows Default
Begin VB.Frame FrameMsg
Caption = "手机信息"
Height = 1215
Left = 240
TabIndex = 6
Top = 1560
Width = 3735
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "制造商: "
Height = 195
Index = 3
Left = 240
TabIndex = 12
Top = 600
Width = 630
End
Begin VB.Label lblManufacturer
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BorderStyle = 1 'Fixed Single
ForeColor = &H00FF0000&
Height = 255
Left = 1200
TabIndex = 11
Top = 480
Width = 2295
End
Begin VB.Label lblDevType
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BorderStyle = 1 'Fixed Single
ForeColor = &H00FF0000&
Height = 255
Left = 1200
TabIndex = 10
Top = 120
Width = 2295
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "手机型号:"
Height = 195
Index = 2
Left = 240
TabIndex = 9
Top = 300
Width = 765
End
Begin VB.Label lblProvider
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BorderStyle = 1 'Fixed Single
ForeColor = &H00FF0000&
Height = 255
Left = 1200
TabIndex = 8
Top = 840
Width = 2295
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "运营服务商: "
Height = 195
Index = 0
Left = 240
TabIndex = 7
Top = 900
Width = 990
End
End
Begin VB.CommandButton cmdConnect
Caption = "连接"
Height = 435
Left = 3000
TabIndex = 5
Top = 840
Width = 1215
End
Begin VB.Frame FrameComm
Caption = "通讯设置"
Height = 1215
Left = 240
TabIndex = 0
Top = 120
Width = 2415
Begin VB.ComboBox cmbBaudrate
Appearance = 0 'Flat
ForeColor = &H00FF0000&
Height = 315
ItemData = "conFrm.frx":0000
Left = 960
List = "conFrm.frx":0010
Style = 2 'Dropdown List
TabIndex = 2
Top = 720
Width = 1215
End
Begin VB.ComboBox cmbPorts
Appearance = 0 'Flat
ForeColor = &H00FF0000&
Height = 315
Left = 960
Style = 2 'Dropdown List
TabIndex = 1
Top = 240
Width = 1215
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "波特率:"
Height = 180
Left = 240
TabIndex = 4
Top = 765
Width = 630
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "端口号: "
Height = 180
Left = 270
TabIndex = 3
Top = 285
Width = 720
End
End
End
Attribute VB_Name = "conFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
ListComPorts
cmbBaudrate.ListIndex = 1
End Sub
Private Sub cmdConnect_Click()
On Error GoTo p1
If Me.cmdConnect.Caption = "连接" Then
If Len(Me.cmbPorts.Text) = 0 Then MsgBox "请选择一个可用的端口...": cmbPorts.SetFocus: Exit Sub
cmdConnect.Caption = "断开"
setStatus "正在连接..."
SeverFrm.MSComm1.RThreshold = 1
SeverFrm.MSComm1.InputLen = 0
SeverFrm.MSComm1.Settings = cmbBaudrate.Text & ",N,8,1"
SeverFrm.MSComm1.DTREnable = True
SeverFrm.MSComm1.InBufferSize = 32
SeverFrm.MSComm1.OutBufferSize = 0
SeverFrm.MSComm1.CommPort = cmbPorts.Text
SeverFrm.MSComm1.RTSEnable = True
DoEvents
SeverFrm.MSComm1.PortOpen = True
DoEvents
setStatus "连接到端口号: " & cmbPorts.Text
DoEvents
' FrameInfo.Enabled = True
' cmdRead.Enabled = True
' cmdSend.Enabled = True
setStatus "获取手机状态...."
getMobileInfo
setStatus "已经成功连接到COM" & cmbPorts.Text
ElseIf Me.cmdConnect.Caption = "断开" Then
cmdConnect.Caption = "连接"
SeverFrm.MSComm1.PortOpen = False
'FrameInfo.Enabled = False
lblDevType.Caption = ""
lblManufacturer.Caption = ""
lblProvider.Caption = ""
setStatus "连接已经断开"
Exit Sub
'LstState.Clear
End If
Dim what As Boolean
txtOut = ""
what = sendIt("AT+CSCA?", "OK", "ERROR")
If what = True Then
CenterNum = getScsa(txtOut)
End If
Exit Sub
p1:
MsgBox "连接失败,请检查端口和连接后重试", vbExclamation, "提示"
End
End Sub
Function getProvider(ByVal s As String)
s1 = ""
If Len(s) > 0 Then
p = InStr(s, Chr(34))
s1 = Mid(s, p + 1)
p1 = InStr(s1, Chr(34))
If p1 > 0 Then
s1 = Mid(s1, 1, p1 - 1)
End If
End If
getProvider = s1
End Function
Function getManufacturer(ByVal s As String)
s1 = ""
If Len(s) > 0 Then
s1 = Mid(s, 11)
p = InStr(s1, Chr(13))
If p = 0 Then p = InStr(s1, Chr(10))
If p > 0 Then
s1 = Mid(s1, 1, p - 1)
End If
End If
getManufacturer = s1
End Function
Function getDevType(ByVal s As String)
s1 = ""
If Len(s) > 0 Then
s1 = Mid(s, 7)
p = InStr(s1, Chr(10))
If p = 0 Then p = InStr(s1, Chr(13))
If p > 0 Then
s1 = Mid(s1, 1, p)
End If
End If
getDevType = s1
End Function
Sub getMobileInfo()
Dim st As Boolean
txtOut = ""
st = sendIt("AT", "OK", "ERROR")
If st = True Then
Else
'Not Connected
MsgBox "没有发现手机"
End
End If
txtOut = ""
st = sendIt("ATI", "OK", "ERROR")
If st = True Then
lblDevType.Caption = getDevType(txtOut)
Else
lblDevType.Caption = ""
End If
txtOut = ""
st = sendIt("AT+CGMI", "OK", "ERROR")
If st = True Then
lblManufacturer.Caption = getManufacturer(txtOut)
Else
lblManufacturer.Caption = ""
End If
txtOut = ""
st = sendIt("AT+COPS?", "OK", "ERROR")
If st = True Then
lblProvider.Caption = getProvider(txtOut)
Else
lblProvider.Caption = ""
End If
st = sendIt("AT+CNMI=?", "OK", "ERROR")
If st = True Then
st = sendIt("AT+CNMI?", "OK", "ERROR")
If st = True Then
st = sendIt("AT+CNMI=2,1", "OK", "ERROR")
If st = True Then
'OK
End If
End If
End If
End Sub
Private Sub ListComPorts()
Dim i As Integer
Me.cmbPorts.Clear
setStatus "获取可用计算机端口..."
For i = 1 To 16
If COMAvailable(i) Then
Me.cmbPorts.AddItem i
'setStatus "COM " & i & " 找到"
End If
Next
Me.cmbPorts.ListIndex = 0
setStatus "获取可用计算机端口成功"
End Sub
Private Sub FrameInfo_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -