'查询软考成绩是否可以查询并发送邮件通知
Option Explicit
Sub SendMail()
'用VBS发送邮件
'http://demon.tw/programming/vbs-send-email.html
Dim CDO
Const Email_From = "user@163.com" '发信邮箱
Const Password = "password" '发信邮箱密码
Const Email_To = "472858200@qq.com" '收信邮箱
Set CDO = CreateObject("CDO.Message")
CDO.Subject = "软考出成绩了" '邮件主题
CDO.From = Email_From
CDO.To = Email_To
CDO.TextBody = "https://www.ruankao.org.cn/" '邮件正文
'cdo.AddAttachment "C:\hello.txt"
Const schema = "http://schemas.microsoft.com/cdo/configuration/"
With CDO.Configuration.Fields
.Item(schema & "sendusing") = 2
.Item(schema & "smtpserver") = "smtp.163.com" 'SMTP服务器地址
.Item(schema & "smtpauthenticate") = 1
.Item(schema & "sendusername") = Email_From
.Item(schema & "sendpassword") = Password
.Item(schema & "smtpserverport") = 465 'SMTP服务端口
.Item(schema & "smtpusessl") = True
.Item(schema & "smtpconnectiontimeout") = 60
.Update
End With
CDO.Send
End Sub
Sub QueryRuankao(KSSJ)
Dim ws,aHttpRequest
Dim URL,HOST,REFERER
Dim r
Set ws=CreateObject("WScript.Shell")
Set aHttpRequest= CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "https://query.ruankao.org.cn/score/main"
HOST="query.ruankao.org.cn"
REFERER="https://www.ruankao.org.cn/"
Do
aHttpRequest.Open "GET", URL, False
'aHttpRequest.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300
'aHttpRequest.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
'aHttpRequest.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
aHttpRequest.setRequestHeader "Host", HOST
aHttpRequest.SetRequestHeader "Referer", REFERER
aHttpRequest.send
If InStr(aHttpRequest.ResponseText,KSSJ)>0 Then
r=ws.Popup(KSSJ & String(20,vbCrLf) & "出了",5,URL,vbSystemModal Or vbInformation Or vbOkOnly)'5秒后自动关闭
SendMail
ws.Run REFERER
Exit Do
Else
r=ws.Popup(KSSJ & String(2,vbCrLf) & vbCrLf & "没出",1,URL,vbMsgBoxSetForeground Or vbQuestion Or vbRetryCancel)
If r=vbCancel Then Exit Do
End If
WScript.Sleep 1000*30 '30秒查一次
Loop
Set aHttpRequest=Nothing
Set ws=Nothing
End Sub
Call QueryRuankao("2022年上半年")