標(biāo)題: 家�；ヂ�(lián)通報(bào) 自動(dòng)查詢器 [打印本頁(yè)]
作者: 51hei麗人    時(shí)間: 2016-6-20 23:10
標(biāo)題: 家�；ヂ�(lián)通報(bào) 自動(dòng)查詢器
''''''''''''''''''''''''''''''''''''''代碼開始''''''''''''''''''''''''''''''''''''''

'版本：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通報(bào)]:"
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通報(bào)]:"
While j<7
  j = j+1
  c = instr(i,x," ",""),vbcrlf,"")<>"[C1009通報(bào)]:" then
  s=msgbox("通報(bào)有更新！" & 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,"天氣預(yù)報(bào)"
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><strong altemp_special" & Chr(34) & ">"
a = InStr(html,str_temp) + Len(str_temp)
b = InStr(a,html,"</strong><br><strong>")
c = b + Len("</strong><br><strong>")
d = InStr(c,html,"</strong><br><span>")
Today_Temp = Mid(html,a,b - a)
Today_Weather = Mid(html,c,d - c)
Today_Wind = Mid(html,d + Len("</strong><br><span>"),InStr(d,html,"</span></td>") - (d + Len("</strong><br><span>")))
a = InStr(d,html,"</a></div>") + Len("</a></div>")
b = InStr(a,html,"<br>")
c = InStr(b + 4,html,"<br><span>")
Tomorrow_Weather = Mid(html,b + 4,c - b - 4)
Tomorrow_Temp = Mid(html,a,b - a)
Tomorrow_Wind = Mid(html,c + Len("<br><span>"),InStr(c,html,"</span></td>") - (c + Len("<br><span>")))
a = InStr(c,html,"</a></div>") + Len("</a></div>")
b = InStr(a,html,"<br>")
c = InStr(b + 4,html,"<br><span>")
the_weather = Mid(html,b + 4,c - b - 4)
the_Temp = Mid(html,a,b - a)
The_Wind = Mid(html,c + Len("<br><span>"),InStr(c,html,"</span></td>") - (c + Len("<br><span>")))
Line1 = "近日天氣預(yù)報(bào)"
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
''''''''''''''''''''''''''''''''''''''代碼結(jié)束''''''''''''''''''''''''''''''''''''''

效果簡(jiǎn)介：
檢查通報(bào)是否有更新，如果有更新就會(huì)提示你，如果沒(méi)有更新就會(huì)守在那里(這個(gè)程序基本不會(huì)占用多少CPU)，一有更新就會(huì)提示你。
并附帶有自動(dòng)查詢天氣預(yù)報(bào)功能。
圖：







動(dòng)作簡(jiǎn)介：
為了記住各個(gè)通報(bào)的標(biāo)題，該程序會(huì)創(chuàng)建C:\TB.txt用于記錄，若殺軟報(bào)毒是正常現(xiàn)象，加入白名單即可。
若沒(méi)有聯(lián)網(wǎng)，會(huì)出現(xiàn)錯(cuò)誤。
若出現(xiàn)錯(cuò)誤，不會(huì)出現(xiàn)提示報(bào)錯(cuò)，程序會(huì)1分鐘后自動(dòng)重新運(yùn)行自己。

使用方法簡(jiǎn)介：
將以上代碼復(fù)制，打開Notepad（記事本），粘貼。將該文件保存，然后放到 開始菜單》所有程序》啟動(dòng) 文件夾下。保存時(shí)擴(kuò)展名一定要是".vbs",文件名可以隨便填。如：通報(bào)查詢.vbs,123.vbs,都可以。

下次開機(jī)時(shí)，你就可以看見(jiàn)效果了。

注1：僅限于C1009班通報(bào)，若需檢查其他班則需要改程序。
注2：若殺軟報(bào)毒，是誤報(bào)，加入白名單即可。（若是360報(bào)毒，純屬360的技術(shù)有問(wèn)題。。。）
注3：稍作更改還可以有更多用途。


附：登陸QQ模塊。
如果你需要開機(jī)就登陸QQ，可以把下面這個(gè)過(guò)程寫進(jìn)去，然后再在適當(dāng)?shù)牡胤秸{(diào)用它。前提是你勾選了“保存密碼”。當(dāng)然，如果你沒(méi)有保存密碼，你也可以用SendKeys方法實(shí)現(xiàn)自動(dòng)輸入密碼。

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






歡迎光臨 (http://www.torrancerestoration.com/bbs/) Powered by Discuz! X3.1