家校互联通报自动查询器

ID:127496 · 发表于 2016-6-20 23:10

''''''''''''''''''''''''''''''''''''''代码开始''''''''''''''''''''''''''''''''''''''

'版本：V1.0
'by ten
On Error Resume Next
Set Sh = CreateObject("Wscript.Shell")
Set xmlh = CreateObject("msxml2.xmlhttp")
Set Fso = Createobject("Scripting.FileSystemObject")
if Not Fso.FileExists("C:\TB.Txt") Then
Set txt = Fso.CreateTextFile("C:\TB.Txt")
txt.writeline "[C1009通报]:"
txt.close
Set txt=nothing
End if
i = 1
j = 0
b = ""
op = True
Set txt = Fso.OpenTextFile("C:\TB.Txt",1)
kb = txt.readall
Txt.close
Set txt=nothing
Do
WScript.Sleep 3000
xmlh.open "GET","http://61.187.64.231/index.aspx?pkId=3379",False
xmlh.send
If Err.Number<>0 Then '=-2146697211 Then
 WScript.Sleep 1000*60
 Sh.Run Chr(34) & Wscript.ScriptFullName & Chr(34)
 Exit Do
End If
x = xmlh.responseText
b = "[C1009通报]:"
While j<7
 j = j+1
 c = instr(i,x," ",""),vbcrlf,"")<>"[C1009通报]:" then
 s=msgbox("通报有更新！" & vbcrlf & b & vbcrlf & "查看吗？",vbYesNo)
 Set txt = Fso.CreateTextFile("C:\TB.Txt")
 txt.write b
 txt.close
 Set txt=nothing
 kb=b
 if s=vbyes then createobject("wscript.shell").run "http://61.187.64.231/index.aspx?pkId=3379"
End if
wscript.sleep 1000*30
If op=true Then op=False:Msgbox Weather(),64,"天气预报"
Loop
Function Weather()
xmlh.open "GET","http://www.baidu.com/s?wd=%CC%EC%C6%F8&f=12&rsp=0&oq=tianqi&tn=baiduhome_pg",False
xmlh.send
html = xmlh.responseText
str_temp = "</a></div>"
a = InStr(html,str_temp) + Len(str_temp)
b = InStr(a,html," ")
c = b + Len(" ")
d = InStr(c,html," ")
Today_Temp = Mid(html,a,b - a)
Today_Weather = Mid(html,c,d - c)
Today_Wind = Mid(html,d + Len(" "),InStr(d,html,"</td>") - (d + Len(" ")))
a = InStr(d,html,"</a></div>") + Len("</a></div>")
b = InStr(a,html," ")
c = InStr(b + 4,html," ")
Tomorrow_Weather = Mid(html,b + 4,c - b - 4)
Tomorrow_Temp = Mid(html,a,b - a)
Tomorrow_Wind = Mid(html,c + Len(" "),InStr(c,html,"</td>") - (c + Len(" ")))
a = InStr(c,html,"</a></div>") + Len("</a></div>")
b = InStr(a,html," ")
c = InStr(b + 4,html," ")
the_weather = Mid(html,b + 4,c - b - 4)
the_Temp = Mid(html,a,b - a)
The_Wind = Mid(html,c + Len(" "),InStr(c,html,"</td>") - (c + Len(" ")))
Line1 = "近日天气预报"
Line2 = "今日" & today_temp & "," & today_weather & "," & today_wind
Line3 = "明日" & tomorrow_temp & "," & tomorrow_weather & "," & tomorrow_wind
Line4 = "后天" & the_temp & "," & the_weather & "," & the_wind
Weather = line1 & vbCrLf & line2 & vbCrLf & line3 & vbCrLf & line4
End Function
''''''''''''''''''''''''''''''''''''''代码结束''''''''''''''''''''''''''''''''''''''

效果简介：
检查通报是否有更新，如果有更新就会提示你，如果没有更新就会守在那里(这个程序基本不会占用多少CPU)，一有更新就会提示你。
并附带有自动查询天气预报功能。
图：

动作简介：
为了记住各个通报的标题，该程序会创建C:\TB.txt用于记录，若杀软报毒是正常现象，加入白名单即可。
若没有联网，会出现错误。
若出现错误，不会出现提示报错，程序会1分钟后自动重新运行自己。

使用方法简介：
将以上代码复制，打开Notepad（记事本），粘贴。将该文件保存，然后放到开始菜单》所有程序》启动文件夹下。保存时扩展名一定要是".vbs",文件名可以随便填。如：通报查询.vbs,123.vbs,都可以。

下次开机时，你就可以看见效果了。

注1：仅限于C1009班通报，若需检查其他班则需要改程序。
注2：若杀软报毒，是误报，加入白名单即可。（若是360报毒，纯属360的技术有问题。。。）
注3：稍作更改还可以有更多用途。

附：登陆QQ模块。
如果你需要开机就登陆QQ，可以把下面这个过程写进去，然后再在适当的地方调用它。前提是你勾选了“保存密码”。当然，如果你没有保存密码，你也可以用SendKeys方法实现自动输入密码。

Sub LoginQQ()
Sh.Run Chr(34) & "E:\Program Files\Tencent\QQ\Bin\QQ.exe" & Chr(34) '启动QQ
Do Until Sh.Appactivate("QQ2012") = True '等待QQ被启动
WScript.Sleep 500
Loop
Sh.Appactivate("QQ2012")
WScript.Sleep 500
Sh.SendKeys "{Enter}"
End Sub

帐号		自动登录	找回密码
密码			立即注册

家校互联通报 自动查询器

评分

家校互联通报自动查询器