📄 pc&gsm.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form FrmMain
BorderStyle = 3 'Fixed Dialog
Caption = "PC机与GSM串口通信程序"
ClientHeight = 2670
ClientLeft = 45
ClientTop = 435
ClientWidth = 8730
FillColor = &H00808080&
Icon = "PC&GSM.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2670
ScaleWidth = 8730
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton CmdRead
Caption = "读取短信"
Height = 390
Left = 420
TabIndex = 14
Top = 2100
Width = 1185
End
Begin VB.CommandButton TestAT
Caption = "测试AT"
Height = 390
Left = 2625
TabIndex = 13
Top = 2100
Width = 1185
End
Begin VB.CommandButton Cmdquit
Caption = "退 出"
Height = 390
Left = 4725
TabIndex = 12
Top = 2100
Width = 1185
End
Begin VB.Frame Frame1
Caption = "返回信息"
Height = 1695
Left = 6090
TabIndex = 8
Top = 105
Width = 2535
Begin VB.TextBox txtReceived
BackColor = &H00FFFFFF&
ForeColor = &H00008000&
Height = 1275
HideSelection = 0 'False
Left = 105
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
ToolTipText = "终端返回的信息内容"
Top = 315
Width = 2310
End
End
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 1000
Left = 7140
Top = 2100
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 80
Left = 6510
Top = 2100
End
Begin VB.Frame Frame
Caption = "短信接收区"
Height = 1755
Index = 31
Left = 105
TabIndex = 1
Top = 105
Width = 5880
Begin VB.TextBox ReadNO
Height = 285
Left = 5250
TabIndex = 10
Text = "1"
Top = 525
Width = 420
End
Begin VB.TextBox SMSNo
Height = 360
Left = 1155
TabIndex = 4
Top = 1260
Width = 1335
End
Begin VB.TextBox SMSTime
Height = 375
Left = 3675
TabIndex = 3
Top = 1245
Width = 2070
End
Begin VB.TextBox SMSText
Height = 705
Left = 1155
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Top = 345
Width = 2790
End
Begin VB.Label Label
Caption = "短信位置："
Height = 255
Index = 76
Left = 4200
TabIndex = 11
Top = 555
Width = 990
End
Begin VB.Label Label
Caption = "短信号码："
Height = 285
Index = 72
Left = 210
TabIndex = 7
Top = 1365
Width = 960
End
Begin VB.Label Label
Caption = "接收时间："
Height = 285
Index = 79
Left = 2730
TabIndex = 6
Top = 1365
Width = 1065
End
Begin VB.Label Label
Caption = "短信内容："
Height = 285
Index = 73
Left = 210
TabIndex = 5
Top = 630
Width = 960
End
End
Begin VB.CommandButton Command8
Caption = "Command4"
Height = 375
Left = 22320
TabIndex = 0
Top = 0
Width = 1695
End
Begin MSCommLib.MSComm MSComm1
Left = 7875
Top = 1995
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
RThreshold = 1
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义模块级变量
Dim ary_strTask(0 To 31) As String
Dim n_TaskWord As Long
'初始化
Private Sub Form_Load()
MSComm1.CommPort = 1
MSComm1.Settings = "9600,n,8,1"
MSComm1.InputLen = 0
MSComm1.RThreshold = 1
MSComm1.SThreshold = 0
MSComm1.PortOpen = True
CmdRead.Enabled = False
End Sub
'测试GSM
Private Sub TestAT_Click()
txtReceived.Text = ""
MSComm1.Output = "AT" & vbCr
MSComm1.Output = "AT+CMGF=0" & vbCr '设置短信发送方式:PDU
Sleep (1000)
MSComm1.Output = "AT+CNMI=" & "3,1,2,0" & vbCr
Sleep (1000)
MSComm1.Output = "AT+CPMS=" & "SM,ME,SM" & vbCr
CmdRead.Enabled = True
End Sub
'读取短消息
Private Sub CmdRead_Click()
If MSComm1.PortOpen = True Then
txtReceived.Text = ""
Call AddTask(n_TaskWord, ary_strTask, 16, 11, "AT+CMGF=1" & vbCr)
Call AddTask(n_TaskWord, ary_strTask, 8, 12, "AT+CMGR=" & ReadNO.Text & vbCr)
End If
If Timer1.Enabled = False Then Timer1.Enabled = True
If Timer2.Enabled = False Then Timer2.Enabled = True
End Sub
Private Sub MSComm1_OnComm()
Dim blTmp As Boolean
Dim strATData As String
Dim strGetInfo As String
Dim tmpBuf() As Byte, strTmp As String, strTmpHex As String, i As Integer
On Error Resume Next
Select Case MSComm1.CommEvent
Case comEvReceive
If g_blIsHexCommData Then
tmpBuf = MSComm1.Input
For i = 0 To UBound(tmpBuf)
strTmpHex = Hex(tmpBuf(i))
If Len(strTmpHex) < 2 Then strTmpHex = "0" & strTmpHex
Next i
Else
strTmp = MSComm1.Input
txtReceived.Text = txtReceived.Text & strTmp
blTmp = GetDataFromCommPort(strTmp, strATData, strGetInfo)
Me.Caption = strGetInfo
End If
Case Else
MsgBox MSComm1.CommEvent
End Select
End Sub
Private Sub Timer2_Timer()
Timer2.Enabled = False
Call cmdAnalosys
End Sub
Private Sub cmdAnalosys()
Dim nU As Long, n As Long
Dim lenpc As Long
Dim strReceived As String
Dim obj_ArySMSList() As SMSDef
On Error Resume Next
strReceived = txtReceived.Text
lenpc = InStr(strReceived, "+CMGR:")
If lenpc > 0 Then
Me.Caption = PickAllSMS1(strReceived, obj_ArySMSList)
Else
Me.Caption = PickAllSMS(strReceived, obj_ArySMSList)
End If
On Error Resume Next
nU = UBound(obj_ArySMSList)
If nU > 0 Then
For n = 1 To nU
If lenpc > 0 Then
SMSNo.Text = obj_ArySMSList(n).SourceNo
SMSTime.Text = Format(obj_ArySMSList(n).ReachDate, "YYYY-MM-DD") & " " & Format(obj_ArySMSList(n).ReachTime, "HH:MM:SS") & vbCrLf
SMSText.Text = obj_ArySMSList(n).SmsMain
End If
Next n
End If
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = ScanTaskA
End Sub
Private Function ScanTaskA() As Boolean
Dim nTmp As Long
Dim i_ScanPtr As Integer
Dim ary_nCommandFlag(0 To 31) As Long
For i = 0 To 15
ary_nCommandFlag(i) = 2 ^ (15 - i)
Next i
On Error Resume Next
ContinueScan:
'======= 取出命令标志数组 =======
nTmp = ary_nCommandFlag(i_ScanPtr)
'======= 察看标志是否等于1 =======
If (n_TaskWord And nTmp) <> 0 Then
'------- 如果有任务存在，则准备执行之,任务执行的条件是串口打开，而且没有正在进行的接收任务 -------
If MSComm1.PortOpen = True Then
'------- 将任务命令下发 -------
MSComm1.Output = ary_strTask(i_ScanPtr)
Else
'------- 如果执行的条件不满足，则保留权利，等待下次会话 -------
ScanTaskA = True
Exit Function
End If
' 如果程序能够执行到此处，说明该任务已经完成那么将该任务的标志删除
n_TaskWord = (n_TaskWord And (Not nTmp))
'因为一个会话只能执行一个任务，因此扫描指针回零，退出当前会话，等待下次会话，重新扫描
i_ScanPtr = 0
ScanTaskA = True
Exit Function
End If
'======= 没有捕获任务，将扫描指针前移一个位置 =======
i_ScanPtr = i_ScanPtr + 1
'------- 如果扫描了整个队列也没有发现任务 -------
If i_ScanPtr >= 16 Then
'------- 结束扫描，等待外部触发 -------
i_ScanPtr = 0
ScanTaskA = False
Else
'------- 否则的话，继续扫描 -------
GoTo ContinueScan
End If
End Function
'退出程序，关闭串口
Private Sub Cmdquit_Click()
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
MSComm1.PortOpen = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -