📄 form1.frm
字号:
Height = 375
Left = 720
TabIndex = 17
Top = 480
Width = 1815
End
End
Begin VB.Image Image1
Height = 480
Left = 10200
Picture = "Form1.frx":0461
Top = 7200
Width = 480
End
Begin VB.Label Label2
Caption = "在下面选择发布对象："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 8400
TabIndex = 9
Top = 840
Width = 2295
End
Begin VB.Label Label1
Caption = "想发布的信息输入在下面的空白处："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 600
TabIndex = 8
Top = 840
Width = 3855
End
End
Attribute VB_Name = "form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click() '发布数据库中 的信息
'Public xxzx As String '短信服务中心号码
'Public ucs2 As String '要发送的信息的ｕｃｓ２编码
'Public len_ucs2 As String '要发送的信息的ｕｃｓ２编码的长度的十六进制表示
'Public sjhma_ys As String '原始手机号码
'Public sjhma_bh As String '变换后的手机号码
'Public geshi1 As String '固定格式１
'Public geshi2 As String '固定格式２
'Public fenlei As Integer '用户分类 １－主要领导 ２－中层 ３－教职工 ４－学生
'Public num_ok As Long '发送成功总数
'Public num_error As Integer '失败总数
Dim out_len As Integer '要发送的全部字符的ｕｃｓ２编码的字节数
Dim i As Integer
Dim j As Integer
Dim today_send_user_num As Integer
Dim str_send As String
Dim temp_bh As String
Dim temp_name As String '本人姓名
Dim find_flag As Boolean
Dim temp_father_name As String '联系人姓名
Dim temp_jb As Integer '本人级别
'------------------------------------只向学生家长定时发布信息(紧急程度=2)-------------
fenlei = 4 '学生标志
'选择未发布记录或发布未成功的记录
sql = "select 编号学号,姓名,短信内容,紧急程度,是否已发布,是否发布成功,发布日期,发布时间 from today_send_info where ((not 是否已发布) or (not 是否发布成功)) and 紧急程度 = 2 order by 编号学号"
'adoRs.Open sql, adoCn, adOpenForwardOnly, adLockReadOnly, adCmdText
adoRs.Open sql, adoCn, adOpenKeyset, adLockBatchOptimistic, 1 ' adCmdTable
'adoRs.Open "today_send_info", adoCn, adOpenKeyset, adLockBatchOptimistic, adCmdTable
today_send_user_num = adoRs.RecordCount
For i = 1 To today_send_user_num
temp_bh = adoRs("编号学号").Value '取编号学号
str_send = adoRs("短信内容").Value '短信内容
'查联系人的手机号和联系人姓名
'sjhma_ys = "8613914347719"
'sjhma_bh = "683119347417F9"
find_flag = False
For j = 1 To user_num
If myuser(j).bh = temp_bh Then
sjhma_ys = myuser(j).gsm_num
temp_jb = myuser(j).jb
If temp_jb = 4 Then '如果为学生，联系人为其父母
temp_father_name = myuser(j).father_name
str_send = myuser(j).name & str_send '加上学生本人的姓名
str_send = temp_father_name & "你好！您的孩子：" & str_send
Else
str_send = myuser(j).name & "你好！" & str_send
End If
find_flag = True
temp_name = myuser(j).name
Exit For
End If
Next j
If find_flag = False Then GoTo Loop1 '未找到就不要发布了
'-------------------------------
sjhma_bh = "68" & Mid(sjhma_ys, 2, 1) & Mid(sjhma_ys, 1, 1) & Mid(sjhma_ys, 4, 1) & Mid(sjhma_ys, 3, 1) & Mid(sjhma_ys, 6, 1) & Mid(sjhma_ys, 5, 1) & Mid(sjhma_ys, 8, 1) & Mid(sjhma_ys, 7, 1) & Mid(sjhma_ys, 10, 1) & Mid(sjhma_ys, 9, 1) & "F" & Mid(sjhma_ys, 11, 1)
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
'out_len = Len("如果收到短信,请回复.") * 2
'str_send = Text1.Text
ucs2 = get_ucs1(str_send)
'ucs2 = get_ucs2(Text1.Text)
'Text1.Text = Text1.Text & vbCrLf & usc2
out_len = Int(Len(ucs2) / 2) ' Len(Text1.Text) * 2
MSComm1.Output = "AT+CMGS=" & Str(15 + out_len) + vbCr
DoEvents
start = Timer
pause = 2
While Timer < start + pause '延时2秒
DoEvents
Wend
'-------------------------------------
' ucs2 = "5982679C6536523077ED4FE1002C8BF756DE590D002E" '如果收到短信，请回复。
'len_ucs2 = "16"
If Len(ucs2) / 2 <= 15 Then '把要发送的信息的ｕｃｓ２编码的长度用十六进制表示
len_ucs2 = "0" & Hex(Int(Len(ucs2) / 2))
Else
len_ucs2 = Hex(Int(Len(ucs2) / 2))
End If
'MSComm1.Output = "0891683110301405F011000D91683159717456F4000800165982679C6536523077ED4FE1002C8BF756DE590D002E" & Chr$(26)
'MSComm1.Output = "0891683108200545f111000D91683100343783F9000800165982679C6536523077ED4FE1002C8BF756DE590D002E" & Chr$(26)
'MSComm1.Output = "0891683110301405F011000D91683119347417F9000800165982679C6536523077ED4FE1002C8BF756DE590D002E" & Chr$(26)
MSComm1.Output = xxzx & geshi1 & sjhma_bh & geshi2 & len_ucs2 & ucs2 & Chr$(26)
start = Timer
pause = 3
While Timer < start + pause '延时3秒
DoEvents
Wend
'--------------------------------------
reco = MSComm1.Input '接收反馈信息
If InStr(reco, "OK") Then
stb.Panels(3).Text = "发送成功"
myuser(j).num_all = myuser(j).num_all + 1
num_ok = num_ok + 1 ' sendsms = True
adoRs.Fields("是否发布成功").Value = True
adoRs.Fields("发布日期").Value = Date
adoRs.Fields("发布时间").Value = Time
End If
If InStr(reco, "ERROR") Then
stb.Panels(3).Text = "发送失败"
num_error = num_error + 1 'Text2.Text = "error" ' sendsms = False
adoRs.Fields("是否发布成功").Value = False
'myuser(j).num_error = myuser(j).num_error + 1 '用户信息库中的故障次数加1
End If
' myuser(j).num_all = myuser(j).num_all + 1 '用户信息库中的总次数加1
stb.Panels(4).Text = "发送总数：" & Str(num_ok + num_error) & Space(4) & "失败总数：" & Str(num_error)
' MSComm1.Output = "AT+CMGS=" & Str(15 + length) + vbCr '中的15为 11000D91683159717456F400080016的位数.length为5982679C6536523077ED4FE1002C8BF756DE590D002E的位数.
adoRs.Fields("是否已发布").Value = True
adoRs.Fields("姓名").Value = temp_name
adoRs.MoveNext
Loop1: Next i
adoRs.UpdateBatch adAffectAllChapters
adoRs.Close
Call mybackup1
End Sub
Private Sub Command2_Click() '立即发布
Dim out_len As Integer '要发送的全部字符的ｕｃｓ２编码的字节数
Dim i As Integer
Dim j As Integer
Dim today_send_user_num As Integer
Dim str_send As String
Dim temp_bh As String
Dim temp_name As String '本人姓名
Dim find_flag As Boolean
Dim temp_father_name As String '联系人姓名
Dim temp_jb As Integer '本人级别
fenlei = 2
today_send_user_num = 2 'adoRs.RecordCount
For i = 1 To 2
'查联系人的手机号和联系人姓名
sjhma_ys = Text2.Text ' "8613914347719"
sjhma_bh = "683119347417F9"
str_send = Text1.Text '
sjhma_bh = "68" & Mid(sjhma_ys, 2, 1) & Mid(sjhma_ys, 1, 1) _
& Mid(sjhma_ys, 4, 1) & Mid(sjhma_ys, 3, 1) & Mid(sjhma_ys, 6, 1) _
& Mid(sjhma_ys, 5, 1) & Mid(sjhma_ys, 8, 1) & Mid(sjhma_ys, 7, 1) _
& Mid(sjhma_ys, 10, 1) & Mid(sjhma_ys, 9, 1) & "F" & Mid(sjhma_ys, 11, 1)
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
ucs2 = get_ucs1(str_send)
out_len = Int(Len(ucs2) / 2)
MSComm1.Output = "AT+CMGS=" & Str(15 + out_len) + vbCr
DoEvents
start = Timer
pause = 2
While Timer < start + pause '延时2秒
DoEvents
Wend
If Len(ucs2) / 2 <= 15 Then '把要发送的信息的ucs２编码的长度用十六进制表示
len_ucs2 = "0" & Hex(Int(Len(ucs2) / 2))
Else
len_ucs2 = Hex(Int(Len(ucs2) / 2))
End If
MSComm1.Output = xxzx & geshi1 & sjhma_bh & geshi2 & len_ucs2 & ucs2 & Chr$(26)
start = Timer
pause = 3
While Timer < start + pause '延时3秒
DoEvents
Wend
reco = MSComm1.Input '接收反馈信息
If InStr(reco, "OK") > 0 Then
stb.Panels(3).Text = "发送成功"
num_ok = num_ok + 1
End If
If InStr(reco, "ERROR") > 0 Then
stb.Panels(3).Text = "发送失败"
num_error = num_error + 1
End If
Loop1:
Next i
stb.Panels(2).Text = "发布完毕"
stb.Panels(4).Text = "发送总数：" & Str(num_ok + num_error) & Space(4) & "失败总数：" & Str(num_error)
End Sub
Private Sub Command3_Click()
Dim out As String
Dim in_str As String
Dim phone_num As String
Dim send_name As String '发信人姓名
Dim accept_name As String '接收人姓名
Dim accept_bh As String '接收人编号
Dim dx_info As String '短信内容
Dim accept_time As String
Dim accept_date As String
Dim num As Integer '短信个数
Dim flag_find As Boolean
Dim rs_myinsert As New ADODB.Recordset '将接收的短信保存到库中
Dim sql_insert As String
'On Error Resume Next
out = "at+cmgl=0" & vbCr '列举未读的短信
MSComm1.Output = out
DoEvents
start = Timer
pause = 2
While Timer < start + pause '延时2秒
DoEvents
Wend
in_str = MSComm1.Input '取接收到的全部短信信息
Text2.Text = Text2.Text & Chr(13) + Chr(10) & in_str
num = 0 '列举未读的短信个数
t = 1
temp = InStr(t, in_str, "+CMGL:", vbTextCompare)
While temp > 0
num = num + 1
t = temp + 1
temp = InStr(t, in_str, "+CMGL:", vbTextCompare)
Wend
If num = 0 Then Exit Sub
Dim accept_info(1000) As String '把每条短信全部内容放入数组中
For i = 1 To num
start = InStr(1, in_str, "089168", vbTextCompare)
mymysecond = InStr(6, in_str, "+CMGL:", vbTextCompare)
If mysecond > 0 Then
accept_info(i) = Mid(in_str, start, mysecond - start)
in_str = Right(in_str, Len(in_str) - mysecond + 1)
Else
accept_info(i) = Right(in_str, Len(in_str) - _
InStr(1, in_str, "089168") + 1)
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -