📄 frmmain.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form FRMMAIN
AutoRedraw = -1 'True
Caption = "短信监控程序"
ClientHeight = 5700
ClientLeft = 2925
ClientTop = 2010
ClientWidth = 9735
Icon = "FRMMAIN.frx":0000
LinkTopic = "Form2"
ScaleHeight = 5700
ScaleWidth = 9735
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 4
Top = 5325
Width = 9735
_ExtentX = 17171
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 5
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 1
Text = "设备连接状态"
TextSave = "设备连接状态"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 4304
MinWidth = 4304
Text = "数据库连接状态："
TextSave = "数据库连接状态："
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 4304
MinWidth = 4304
EndProperty
EndProperty
End
Begin VB.CommandButton Command2
Caption = "连接数据库"
Height = 375
Left = 5880
TabIndex = 3
Top = 4920
Width = 2055
End
Begin VB.CommandButton Command1
Caption = "连接MODEM"
Height = 375
Left = 1920
TabIndex = 2
Top = 4920
Width = 2175
End
Begin VB.Timer Timer1
Interval = 1000
Left = 0
Top = 4680
End
Begin VB.Frame Frame2
Caption = "发送信息状态"
Height = 2175
Left = 120
TabIndex = 1
Top = 2520
Width = 9495
Begin MSComctlLib.ListView ListView2
Height = 1815
Left = 120
TabIndex = 6
Top = 240
Width = 9255
_ExtentX = 16325
_ExtentY = 3201
View = 3
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
End
Begin VB.Frame Frame1
Caption = "接收信息状态"
Height = 1935
Left = 120
TabIndex = 0
Top = 240
Width = 9495
Begin MSComctlLib.ListView ListView1
Height = 1575
Left = 120
TabIndex = 5
Top = 240
Width = 9255
_ExtentX = 16325
_ExtentY = 2778
View = 3
Arrange = 2
LabelWrap = -1 'True
HideSelection = -1 'True
AllowReorder = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
End
Begin MSCommLib.MSComm MSComm1
Left = 0
Top = 5040
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.Menu GNXX
Caption = "功能选项"
Begin VB.Menu SMSCS
Caption = "短信发送测试"
End
Begin VB.Menu DATABASECS
Caption = "数据库连接测试"
End
Begin VB.Menu dxzx
Caption = "短信中心号码配置"
End
Begin VB.Menu EXITSUB
Caption = "退出"
End
End
End
Attribute VB_Name = "FRMMAIN"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim T2 As Integer, t3 As Integer, smsid As Integer 't2 时间记数 t3 短信提取记数，SMSID短信标示（第几条）
Dim SendMsg As String '短信内容
Dim usernum As String '用户手机号码
Private Sub Command1_Click()
Call SmsOpen
End Sub
Private Sub dxzx_Click()
Frmdxzx.Show
FRMMAIN.Hide
End Sub
Private Sub EXITSUB_Click()
Unload FORM1
Unload Me
End Sub
Private Sub Form_Load()
StatusBar1.Panels.Item(2).Text = "未连接"
StatusBar1.Panels.Item(4).Text = "未连接"
ListView1.ColumnHeaders.Add , , "接收序号", ListView1.Width / 4
ListView1.ColumnHeaders.Add , , "信息内容", ListView1.Width / 4
ListView1.ColumnHeaders.Add , , "接收时间", ListView1.Width / 4
ListView1.ColumnHeaders.Add , , "接收状态", ListView1.Width / 4
ListView2.ColumnHeaders.Add , , "发送序号", ListView1.Width / 4
ListView2.ColumnHeaders.Add , , "信息内容", ListView1.Width / 4
ListView2.ColumnHeaders.Add , , "发送时间", ListView1.Width / 4
ListView2.ColumnHeaders.Add , , "发送状态", ListView1.Width / 4
End Sub
Private Sub Form_Resize()
If FRMMAIN.Height <> "6510" Or FRMMAIN.Width <> "9855" Then '限制窗体改变
FRMMAIN.Height = "6510"
FRMMAIN.Width = "9855"
End If
End Sub
Private Sub MSComm1_OnComm() '实时监听新短信到来
Dim realbuf As String
Do
DoEvents
realbuf = realbuf + MSComm1.Input
Loop Until InStr(realbuf, "+CMTI")
If InStr(realbuf, "+CMTI") > 0 Then
smsid = Right(realbuf, Int(InStr(realbuf, "+CMTI") + 11))
Call SMSREAL
End If
End Sub
Private Sub SMSCS_Click()
FORM1.Show
FRMMAIN.Hide
End Sub
Private Sub SmsOpen() '被opensms_click 调用
Dim i As Integer, j As Integer
Dim buffer As String
buffer = ""
T2 = 0
If MSComm1.PortOpen = False Then
MSComm1.CommPort = "1"
MSComm1.Settings = "9600,n,8,1"
MSComm1.InputLen = 0
MSComm1.PortOpen = True
If MSComm1.PortOpen = True Then
MSComm1.Output = "AT" & vbCr '上边两行语句作为联机是初始化用的命令
End If
End If
Do
DoEvents
buffer = buffer + MSComm1.Input
Loop Until T2 = 3 '等2秒接受MODEM反应
If InStr(buffer, "OK") > 0 Then
StatusBar1.Panels.Item(2).Text = "连接成功"
Else
MsgBox "请检查MODEM设备是否正常连接！"
Exit Sub
End If
End Sub
Private Sub Timer1_Timer()
StatusBar1.Panels.Item(5).Text = Date & "--" & Time
T2 = T2 + 1
t3 = t3 + 1 '监控程序记时
End Sub
Private Sub SMSREAL() '新短信处理模块
Dim buffer As String '接收缓从
Dim txtmsgTEMP As String, TXTMSG As String
Dim i1 As Integer, ID As Integer, di As Integer
If MSComm1.PortOpen = True Then
MSComm1.Output = "AT+CMGR=" & Int(smsid) & vbCr
Else
MsgBox "GSM网络故障请重联MODEM"
Exit Sub
End If
t3 = 0 '清空记时变量
Do
DoEvents
buffer = buffer + MSComm1.Input '等2秒左右
Loop Until t3 = 2 And InStr(buffer, "+CMGR:")
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 = TXTMSG '
Call listmsg
End Sub
Private Sub listmsg() '短信列表显示
ListView1.ListItems.Add , , "123 "
Call delmsg '调用信息删除，保持MODEM设备内存可用
End Sub
Private Sub delmsg() '腾出内存空间
If FRMMAIN.MSComm1.PortOpen = True Then
FRMMAIN.MSComm1.Output = "AT+CMGD=" & Int(smsid) & vbCr
Do
DoEvents
buffer = buffer + FRMMAIN.MSComm1.Input
Loop Until InStr(buffer, "OK")
Call SMSBACK
Else
MsgBox "GSM网络故障请重联MODEM"
Exit Sub
End If
End Sub
Private Sub SMSBACK() '自动回复用户查询
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -