📄 测试窗.frm
字号:
BorderStyle = 1 'Fixed Single
Height = 255
Index = 8
Left = 1665
TabIndex = 14
Top = 2940
Width = 1830
End
Begin VB.Label Label8
BackColor = &H00FFFF00&
BorderStyle = 1 'Fixed Single
Height = 255
Index = 7
Left = 1665
TabIndex = 13
Top = 2595
Width = 1830
End
Begin VB.Label Label8
BackColor = &H00FFFF00&
BorderStyle = 1 'Fixed Single
Height = 255
Index = 6
Left = 1665
TabIndex = 12
Top = 2250
Width = 1830
End
Begin VB.Label Label8
BackColor = &H00FFFF00&
BorderStyle = 1 'Fixed Single
Height = 255
Index = 5
Left = 1665
TabIndex = 11
Top = 1905
Width = 1830
End
Begin VB.Label Label8
BackColor = &H00FFFF00&
BorderStyle = 1 'Fixed Single
Height = 255
Index = 4
Left = 1665
TabIndex = 10
Top = 1560
Width = 1830
End
Begin VB.Label Label8
BackColor = &H00FFFF00&
BorderStyle = 1 'Fixed Single
Height = 255
Index = 3
Left = 1665
TabIndex = 9
Top = 1230
Width = 1830
End
Begin VB.Label Label8
BackColor = &H00FFFF00&
BorderStyle = 1 'Fixed Single
Height = 255
Index = 2
Left = 1665
TabIndex = 8
Top = 900
Width = 1830
End
Begin VB.Label Label8
BackColor = &H00FFFF00&
BorderStyle = 1 'Fixed Single
Height = 255
Index = 1
Left = 1665
TabIndex = 7
Top = 570
Width = 1830
End
Begin VB.Label Label8
BackColor = &H00FFFF00&
BorderStyle = 1 'Fixed Single
Height = 255
Index = 0
Left = 1665
TabIndex = 6
Top = 240
Width = 1830
End
Begin VB.Label Label8
BackColor = &H00FFFF00&
BorderStyle = 1 'Fixed Single
Height = 255
Index = 12
Left = 1680
TabIndex = 5
Top = 4320
Width = 1830
End
Begin VB.Label Label8
BackColor = &H00FFFF00&
BorderStyle = 1 'Fixed Single
Height = 255
Index = 13
Left = 1665
TabIndex = 4
Top = 4665
Width = 1830
End
Begin VB.Label Label8
BackColor = &H00FFFF00&
BorderStyle = 1 'Fixed Single
Height = 255
Index = 14
Left = 1665
TabIndex = 3
Top = 5010
Width = 1830
End
End
Begin VB.Frame Frame2
Caption = "信息"
Height = 6255
Left = 7890
TabIndex = 0
Top = 60
Width = 3075
Begin VB.OptionButton Option1
Caption = "MT设备"
Enabled = 0 'False
Height = 255
Index = 1
Left = 900
TabIndex = 41
Top = 5460
Width = 915
End
Begin VB.OptionButton Option1
Caption = "SIM卡"
Enabled = 0 'False
Height = 195
Index = 0
Left = 90
TabIndex = 40
Top = 5490
Width = 945
End
Begin VB.CommandButton Command4
Caption = "读电话本"
Height = 330
Left = 690
TabIndex = 38
Top = 5760
Width = 1005
End
Begin VB.CommandButton Command2
Caption = "读电话内存"
Enabled = 0 'False
Height = 345
Left = 1815
TabIndex = 19
Top = 7260
Width = 1095
End
Begin VB.ListBox List1
Height = 4920
Left = 90
TabIndex = 1
Top = 240
Width = 2895
End
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 7680
Top = 6240
End
End
Attribute VB_Name = "测试窗"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim GSMtype As String
Public Sub DD()
End Sub
'读取短信
Private Sub Command1_Click()
Dim sourceDat
Dim sSms As String, SheBei As String, ATT As String
Dim i As Integer, SMStotal As Integer
Text2 = ""
Dim sMsg As String
Timer1.Enabled = False
If statuGSM = False Then
MsgBox "没有建立连接，请先连接设备！", vbCritical, "提示"
Exit Sub
End If
SheBei = Combo5.List(Combo5.ListIndex)
sSms = GetShortinfo(SheBei)
If SheBei = "SM" Then Label8(8).Caption = "SIM卡:" & sSms
If SheBei = "ME" Then Label8(7).Caption = "设备:" & sSms
If Val(Right(sSms, Len(sSms) - InStr(sSms, "/"))) = 0 Then
MsgBox "设备中暂时没有短信!", vbInformation, "提示"
Exit Sub
End If
Screen.MousePointer = 11
Call SendAT("AT+CMGF=0", 5)
Pause 0.1
Label4.Caption = "正在读取短信,请稍候..."
For i = 1 To Val(Right(sSms, Len(sSms) - InStr(sSms, "/")))
RepeatRead:
sSms = SendAT("AT+CMGR=" & i, 25)
Pause 0.1
If Left(sSms, 2) = "超时" Then GoTo RepeatRead
If InStr(UCase(sSms), "ERROR") = 0 Then '如果短信位置为删除
If InStr(sSms, "+CMGR:") = 0 Then GoTo RepeatRead '信息不完整,重新读取
sourceDat = GetMsgPDU(sSms) '正确后进行处理
Text2 = Text2 & "序号:" & CStr(i) & vbCrLf & "----------" & vbCrLf _
& "短信中心：" & GetMsgSCA(sourceDat) & vbCrLf _
& "短信时间：" & GetMsgTime(sourceDat) & vbCrLf _
& "对方号码：" & GetMsgPhone(sourceDat) & vbCrLf _
& "短信内容：" & vbCrLf & GetMsgText(sourceDat) & vbCrLf _
& "---------- " & vbCrLf
If Check3.Value Then '是否删除
Call SendAT("AT+CMGD=" & i, 5)
End If
End If
Next
Screen.MousePointer = 0
Label4.Caption = "短信读取完毕!"
Timer1.Enabled = True
End Sub
Private Sub Command5_Click()
Screen.MousePointer = 11
If SendSMS(Combo4, Text4) Then
Label4.Caption = "短信发送成功!"
Screen.MousePointer = 0
Else
Label4.Caption = "短信发送失败!"
Screen.MousePointer = 0
End If
End Sub
Private Sub Command6_Click()
Text1_KeyPress (13)
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Dim i As Integer
'MsgBox KeyCode
If Shift = 2 Then
If KeyCode = 65 Then
For i = 0 To 14
Check4(i).Value = Checked
Next i
ElseIf KeyCode = 68 Then
For i = 0 To 14
Check4(i).Value = Unchecked
Next i
End If
End If
End Sub
Private Sub Form_Load()
Combo1.ListIndex = 0
Combo2.ListIndex = 0
Combo3.ListIndex = 0
Combo5.ListIndex = 0
End Sub
'关闭设备
Private Sub CmdClose_Click()
End Sub
'打开设备
Private Sub CmdOpen_Click()
Dim ConnetID As Integer
If CmdOpen.Caption = "断开连接(&H)" Then
Call CloseCOM32
Timer1.Enabled = False
CmdOpen.Enabled = True
statuGSM = False
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command5.Enabled = False
Check3.Enabled = False
CmdOpen.Caption = "连接设备(&C)"
Label4.Caption = "当前设备已被断开!" & Space(8)
Exit Sub
End If
Label4.Caption = "正在连接设备中..."
Timer1.Enabled = False
Call CloseCOM32
ConnetID = StartCOM32(Combo1.Text & ":", Combo2.Text & ",n,8,1")
If ConnetID = 0 Then
Text1.Enabled = True
Label4.Caption = "当前设备连接成功!"
statuGSM = True
Timer1.Enabled = True
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command5.Enabled = True
Check3.Enabled = True
CmdOpen.Caption = "断开连接(&H)"
Label4.Caption = "完毕，待机中...."
Else
Label4.Caption = "连接不成功！错误代码：" & ConnetID
End If
End Sub
Private Sub Command4_Click()
Dim i As Integer
Dim sTotal As String, sItem As String
If statuGSM = False Then
MsgBox "没有建立连接，请先连接设备！", vbCritical, "提示"
Exit Sub
End If
Timer1.Enabled = False
Call sGetCSCS
sTotal = GetPBinfo("SM")
For i = 1 To Val(Left(sTotal, InStr(sTotal, "/") - 1)) + 1
sItem = GetTelNameinPB(i)
If sItem <> "" Then
List1.AddItem List1.ListCount + 1 & vbTab & sItem
End If
Next
Timer1.Enabled = True
End Sub
Private Sub Command3_Click()
If statuGSM = False Then
MsgBox "没有建立连接，请先连接设备！", vbCritical, "提示"
Exit Sub
End If
Timer1.Enabled = False
Screen.MousePointer = 11
If Check4(0).Value Then Label8(0).Caption = GetCGMI
' Pause 0.05
If Check4(1).Value Then Label8(1).Caption = GetCGMM
' Pause 0.05
If Check4(2).Value Then Label8(2).Caption = GetCGMR
' Pause 0.05
If Check4(3).Value Then Label8(3).Caption = GetCGSNimei
' Pause 0.05
If Check4(4).Value Then Label8(4).Caption = GetCIMIimsi
' Pause 0.05
If Check4(5).Value Then Label8(5).Caption = GetCSCA
' Pause 0.05
If Check4(6).Value Then Label8(6).Caption = GetCOPS
' Pause 0.05
If Check4(7).Value Then Label8(7).Caption = "设备:" & GetShortinfo("ME")
' Pause 0.05
If Check4(8).Value Then Label8(8).Caption = "SIM卡:" & GetShortinfo("SM")
' Pause 0.05
If Check4(9).Value Then Label8(9).Caption = GetPBinfo("SM")
' Pause 0.05
If Check4(10).Value Then Label8(10).Caption = GetAddresslist
' Pause 0.05
If Check4(11).Value Then Label8(11).Caption = GetCNUM
' Pause 0.05
If Check4(12).Value Then Label8(12).Caption = GetCSQ
' Pause 0.05
If Check4(13).Value Then Label8(13) = GetCCLK
' Pause 0.05
If Check4(14).Value Then Label8(14).Caption = GetCBC
Dim i As Integer
For i = 0 To 14
Check4(i).Value = Unchecked
Next i
Screen.MousePointer = 0
Timer1.Enabled = True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If statuGSM Then
Call CloseCOM32
End If
End Sub
Private Sub Label8_Click(Index As Integer)
Label8(Index).Caption = ""
End Sub
Private Sub List1_dblClick()
List1.Clear
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If statuGSM Then
Timer1.Enabled = False
DoEvents
Text2 = Text2 & SendAT(Text1, 25)
If InStr(Text2, "ERROR") <> 0 Then Exit Sub
If Left(Text1, 7) = "AT+CMGL" Or Left(Text1, 7) = "AT+CMGR" Then
Dim sourceDat
Dim i As Integer
sourceDat = Split(Text2, Mid(Text1, 3, 5) & ":")
Text2 = ""
For i = 1 To UBound(sourceDat)
Text2 = Text2 & GetMsgText(Left(Right(sourceDat(i), Len(sourceDat(i)) - InStr(sourceDat(i), "08") + 1), InStr((Right(sourceDat(i), Len(sourceDat(i)) - InStr(sourceDat(i), "08") + 1)), vbCrLf) - 1)) & vbCrLf & "-----------------" & vbCrLf
Next i
End If
Timer1.Enabled = True
Else
Text2 = Text2 & "端口没有打开!" & vbCrLf
End If
End If
End Sub
Private Sub Text2_DblClick()
Text2 = ""
End Sub
Private Sub Text4_DblClick()
Text4 = ""
End Sub
'接收短信
Private Sub Timer1_Timer()
Dim DataCOM32 As String
Dim T1, T2 As String
Dim ReceveMsg As String
DataCOM32 = ReadCOM32()
Call FlushCOM32
If (InStr(DataCOM32, "+CMTI") > 0) Then '有短信
' Text2 = Text2 & DataCOM32 & vbCrLf
ReceveMsg = ReadNewSMS(DataCOM32)
Text2 = Text2 & "新消息:" & vbCrLf & "----------" & vbCrLf _
& "短信中心：" & GetMsgSCA(ReceveMsg) & vbCrLf _
& "短信时间：" & GetMsgTime(ReceveMsg) & vbCrLf _
& "对方号码：" & GetMsgPhone(ReceveMsg) & vbCrLf _
& "短信内容：" & vbCrLf & GetMsgText(ReceveMsg) & vbCrLf _
& "---------- " & vbCrLf
Exit Sub
ElseIf (InStr(DataCOM32, "+CDSI") > 0) Then '有状态报告
' Text2 = Text2 & DataCOM32 & vbCrLf
' ReceveMsg = ReadNewSMS(DataCOM32)
' Text2 = Text2 & ReceveMsg & vbCrLf & "-----------------------" & vbCrLf
Exit Sub
ElseIf (InStr(DataCOM32, "RING") > 0) Then '有来电
' Text2 = Text2 & DataCOM32 & vbCrLf
T1 = Split(DataCOM32, " ")(0)
T2 = Split(DataCOM32, " ")(1)
Text2 = Text2 & vbCrLf & "来电:" & Mid(T2, 2, InStr(T2, ",") - 3) & vbCrLf
Exit Sub
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -