📄 form1.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
Caption = "短信测试程序"
ClientHeight = 4275
ClientLeft = 4770
ClientTop = 2760
ClientWidth = 6735
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
ScaleHeight = 4275
ScaleWidth = 6735
Begin VB.CommandButton Command3
Caption = "删除信息"
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3240
TabIndex = 10
Top = 3240
Width = 1455
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 240
Top = 2760
End
Begin VB.CommandButton Command2
Caption = "返回"
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4920
TabIndex = 9
Top = 3240
Width = 1575
End
Begin VB.TextBox MsgIndex
Appearance = 0 'Flat
Height = 360
Left = 2760
TabIndex = 7
Top = 2280
Width = 495
End
Begin VB.CommandButton Command1
Caption = "接收"
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1680
TabIndex = 6
Top = 3240
Width = 1455
End
Begin MSComctlLib.StatusBar Status
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 5
Top = 3900
Width = 6735
_ExtentX = 11880
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 5
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 2293
MinWidth = 2293
Text = "发送状态："
TextSave = "发送状态："
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 2117
MinWidth = 2117
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 2293
MinWidth = 2293
Text = "成功次数："
TextSave = "成功次数："
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.CommandButton Send
Caption = "发送"
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 4
Top = 3240
Width = 1215
End
Begin VB.TextBox SendMsg
Appearance = 0 'Flat
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1095
Left = 2760
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 1080
Width = 3615
End
Begin VB.TextBox MobileTel
Appearance = 0 'Flat
Height = 375
Left = 2760
TabIndex = 1
Top = 360
Width = 3615
End
Begin VB.Label Label3
Caption = "短信接收索引号"
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 720
TabIndex = 8
Top = 2280
Width = 1695
End
Begin VB.Label Label2
Caption = "短信息内容："
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
TabIndex = 2
Top = 1200
Width = 1575
End
Begin VB.Label Label1
Caption = "对方手机号："
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 840
TabIndex = 0
Top = 360
Width = 1695
End
End
Attribute VB_Name = "FORM1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim msgtext '短消息内容变量
Dim tep As String
Dim temp As String
Dim i As Integer '内容长度
Dim B1 As Integer, T1 As Integer
Private Sub Command1_Click() '
Call RequestRecMsg '调用短消息接收模块
End Sub
Private Sub Command2_Click() '返回主窗体
FRMMAIN.Show
Unload Me
End Sub
Private Sub Command3_Click()
Call delmsg
End Sub
Private Sub Form_Load()
FORM1.Hide
FRMMAIN.Show
End Sub
Private Sub smssend() '短信发送模块
Dim SENDfailID As Integer
Dim flag1 As Integer '表示判断MODEM是否可以发送的标志
Dim flag2 As Integer '表示发送成功与否的标志
Dim flag3 As Integer '判断短信文本OR PDU格式与否
Dim xxcd As Byte
Dim temp1 As Integer
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, n As Integer, f As Integer, g As Integer, j As Integer, k As Integer, m As Integer
Dim i1 As Integer
Dim buffer As String
'If FRMMAIN.MSComm1.PortOpen = True Then
'FRMMAIN.MSComm1.Output = "AT+CMGF=1" & vbCr '定义短消息为文本格式
'FRMMAIN.MSComm1.Output = "AT+CMGS=" & MobileTel.Text & vbCr '送出短信目的号码
' FRMMAIN.MSComm1.Output = msgtext + Chr(26)
SMSCID = "683108301505F0" '短信中心号码
DESN = MobileTel.Text
i1 = 1
a = Mid(DESN, i1, 1)
b = Mid(DESN, i1 + 1, 1)
c = Mid(DESN, i1 + 2, 1)
d = Mid(DESN, i1 + 3, 1)
e = Mid(DESN, i1 + 4, 1)
n = Mid(DESN, i1 + 5, 1)
f = Mid(DESN, i1 + 6, 1)
g = Mid(DESN, i1 + 7, 1)
j = Mid(DESN, i1 + 8, 1)
k = Mid(DESN, i1 + 9, 1)
m = Mid(DESN, i1 + 10, 1)
DESNUM = b & a & d & c & n & e & g & f & k & j & "F" & m '逆返目的手机号码
xxcd = 14 + B1 * 2
If B1 * 2 < 16 Then
nrcd = "0" & Hex(B1 * 2)
Else
nrcd = Hex(B1 * 2)
End If
msgtext = "0891" & SMSCID & "1100" & "0B81" & DESNUM & "0008A7" & nrcd & msgtext
If FRMMAIN.MSComm1.PortOpen = True Then
FRMMAIN.MSComm1.Output = "AT+CMGF=0" & vbCr '定义短消息为PDU格式
FRMMAIN.MSComm1.Output = "AT+CMGS=" & xxcd & vbCr '送出短信整体编码长度
FRMMAIN.MSComm1.Output = msgtext + Chr(26) '送出短消息内容
Else
MsgBox "GSM网络故障请重联MODEM"
Exit Sub
End If
Timer1.Enabled = True
Do
DoEvents
buffer$ = buffer$ + FRMMAIN.MSComm1.Input
Loop Until T1 = 3 'InStr(BUFFER$, "err")
If InStr(buffer$, "err") <> 0 Then
MsgBox "未发送成功!"
Timer1.Enabled = False
Exit Sub
Else
MsgBox "发送成功!"
Timer1.Enabled = False
End If
End Sub
Private Sub Send_Click()
Dim a As String, b As String, c As String, d As String
T1 = 0 '清空记时变量
If Len(MobileTel.Text) < 11 Then 'LEN函数返回字符串内字符的数目，或是存储一变量所需的字节数
MsgBox "请输入正确的手机号"
Exit Sub
End If
If Len(SendMsg.Text) < 1 Or Len(SendMsg.Text) > 50 Then
MsgBox "必须信息或输入的信息不能超过50"
Exit Sub
End If
Status.Panels(2).Text = "正在发送..."
Call chg(SendMsg.Text) '调用字符转换UNICODE模块
End Sub
Private Sub RequestRecMsg() '短信接收模块
Dim buffer As String '接收缓从
Dim txtmsgTEMP As String, TXTMSG As String
Dim i1 As Integer, ID As Integer, di As Integer
T1 = 0 '清空记时变量
If FRMMAIN.MSComm1.PortOpen = True Then
If MsgIndex.Text <> "" Then
FRMMAIN.MSComm1.Output = "AT+CSDH=0" & vbCr
FRMMAIN.MSComm1.Output = "AT+CMGR=" & Int(MsgIndex.Text) & vbCr
Else
MsgBox "索引号不能为空！"
Exit Sub
End If
Else
MsgBox "GSM网络故障请重联MODEM"
Exit Sub
End If
Timer1.Enabled = True '开始记时
If T1 <= 30 Then
Do
DoEvents
buffer = buffer + FRMMAIN.MSComm1.Input '等2秒左右
Loop Until T1 = 1 And InStr(buffer, "+CMGR:")
Timer1.Enabled = False
ID = InStr(buffer, "0891") + 58
di = ID + 3
txtmsgTEMP = Mid(buffer, ID, Int(Len(buffer)) - di) '取出短信PDU内容
i1 = 0 '记数值清零
Do
i1 = i1 + 4
TXTMSG = TXTMSG + ChrW(CLng("&H" & Mid(Left(txtmsgTEMP, Len(txtmsgTEMP) - 2), i1 - 3, 4))) '首先取值四位，变为十进制（UNICODE码制），再改为中文显示
Loop Until i1 = Len(txtmsgTEMP) - 4 '短信内容提取显示完毕
SendMsg.Text = TXTMSG '
Else
MsgBox "MODEM响应超时！"
Exit Sub
Timer1.Enabled = False
End If
End Sub
Public Function chg(rmsg As String) As String '字符转换UNICODE(中文)
Dim unstr As String, unstr2 As String 'UNICODE传
tep = rmsg
B1 = Len(tep) '内容长度
For i = i + 1 To B1
temp = Mid(tep, i, 1)
If Len(Hex(AscW(temp))) > 2 Then
unstr1 = unstr1 & Hex(AscW(temp))
Else
unstr2 = unstr2 & 0 & 0 & Hex(AscW(temp))
End If
msgtext = unstr1 + unstr2
Next
Call smssend '调用短信发送模块
End Function
Private Sub Timer1_Timer()
T1 = T1 + 1 '以秒为时间间隔
End Sub
Private Sub delmsg()
Dim buffer As String
If FRMMAIN.MSComm1.PortOpen = True Then
If MsgIndex.Text <> "" Then
FRMMAIN.MSComm1.Output = "AT+CMGD=" & Int(MsgIndex.Text) & vbCr
Else
MsgBox "未指定被删除对象！"
Exit Sub
End If
End If
Do
DoEvents
buffer = buffer + FRMMAIN.MSComm1.Input
Loop Until InStr(buffer, "OK")
SendMsg.Text = ""
MsgIndex.Text = ""
MsgBox "第" & MsgIndex.Text & "条短信被成功删除！"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -