vbs 百度小助手

更新時(shí)間：2009年12月23日 23:44:45 作者：

每天沒事到百度上回答問題要先打開IE，輸入BAIDU，點(diǎn)百度知道，點(diǎn)我要回答，再輸入要回答的問題類別，很麻煩，于是寫了這樣一個(gè)百度小助手.

運(yùn)行它直接選擇：
1.我要回答;2.歌曲搜索;3,新聞搜索;4.網(wǎng)頁搜索;5.貼吧搜索;6.知道搜索;7.圖片搜索;8.視頻搜索;9;百科搜索;
然后輸入需要搜索的內(nèi)容即可直接自動(dòng)打開轉(zhuǎn)到指定網(wǎng)址自動(dòng)進(jìn)行搜索．

復(fù)制代碼代碼如下:

xz=InputBox("1.我要回答;2.歌曲搜索;3,新聞搜索;" & Chr(13) & "4.網(wǎng)頁搜索;5.貼吧搜索;6.知道搜索;" & Chr(13) & "7.圖片搜索;8.視頻搜索;9;百科搜索;","百度小助手 [Null_vbt]","") 
If Len(xz)=0 Then 
MsgBox "沒有選擇，腳本退出！",64,"錯(cuò)誤" 
WScript.Quit 
else 
Select Case xz 
Case 1 
x=Urlcode(InputBox("請輸入要回答的問題","百度我要回答","")) 
If Len(x)=0 Then 
MsgBox "沒有檢測到內(nèi)容，腳本退出！",64,"錯(cuò)誤" 
WScript.Quit 
else 
strurl="http://zhidao.baidu.com/q?word=" & x & "&ct=17&pn=0&tn=ikaslist&rn=10&lm=65536&fr=answersearch_0" 
End if 
Case 2 
x=Urlcode(InputBox("請輸入要搜索的歌曲名","百度歌曲搜索","")) 
If Len(x)=0 Then 
MsgBox "沒有檢測到內(nèi)容，腳本退出！",64,"錯(cuò)誤" 
WScript.Quit 
Else 
strurl="http://mp3.baidu.com/m?f=ms&tn=baidump3&ct=134217728&lf=&rn=&word=" & x & "&lm=-1" 
End if 
Case 3 
x=Urlcode(InputBox("請輸入要搜索的新聞標(biāo)題","百度新聞搜索","")) 
If Len(x)=0 Then 
MsgBox "沒有檢測到內(nèi)容，腳本退出！",64,"錯(cuò)誤" 
WScript.Quit 
else 
strurl="http://news.baidu.com/ns?cl=2&rn=20&tn=news&word=" & x & "&t=1" 
End if 
Case 4 
x=Urlcode(InputBox("請輸入要搜索的內(nèi)容","百度網(wǎng)頁搜索","")) 
If Len(x)=0 Then 
MsgBox "沒有檢測到內(nèi)容，腳本退出！",64,"錯(cuò)誤" 
WScript.Quit 
else 
strurl="http://www.baidu.com/s?cl=3&wd=" & x 
End if 
Case 5 
x=Urlcode(InputBox("請輸入要搜索的貼子標(biāo)題","百度貼吧搜索","")) 
If Len(x)=0 Then 
MsgBox "沒有檢測到內(nèi)容，腳本退出！",64,"錯(cuò)誤" 
WScript.Quit 
else 
strurl="http://tieba.baidu.com/f?kw=" & x 
End if 
Case 6 
x=InputBox("請輸入要搜索的知道標(biāo)題","百度知道搜索","") 
If Len(x)=0 Then 
MsgBox "沒有檢測到內(nèi)容，腳本退出！",64,"錯(cuò)誤" 
WScript.Quit 
else 
strurl="http://zhidao.baidu.com/q?ct=17&pn=0&tn=ikaslist&rn=10&word=" & x 
End if 
Case 7 
x=Urlcode(InputBox("請輸入要搜索的圖片標(biāo)題","百度圖片搜索","")) 
If Len(x)=0 Then 
MsgBox "沒有檢測到內(nèi)容，腳本退出！",64,"錯(cuò)誤" 
WScript.Quit 
else 
strurl="http://image.baidu.com/i?tn=baiduimage&ct=201326592&lm=-1&cl=2&word=" & x & "&t=3" 
End if 
Case 8 
x=Urlcode(InputBox("請輸入要搜索的視頻標(biāo)題","百度視頻搜索","")) 
If Len(x)=0 Then 
MsgBox "沒有檢測到內(nèi)容，腳本退出！",64,"錯(cuò)誤" 
WScript.Quit 
else 
strurl="http://video.baidu.com/v?ct=301989888&rn=20&pn=0&db=0&s=7&word=" & x 
End if 
Case 9 
x=Urlcode(InputBox("請輸入要搜索的百科標(biāo)題","百度百科搜索","")) 
If Len(x)=0 Then 
MsgBox "沒有檢測到內(nèi)容，腳本退出！",64,"錯(cuò)誤" 
WScript.Quit 
else 
strurl="http://baike.baidu.com/w?ct=17&lm=0&tn=baiduWikiSearch&pn=0&rn=10&word=" & x 
End if 
End Select 
End if 
Set objIe = CreateObject("InternetExplorer.Application") 
objie.visible=true 
objIe.Navigate strUrl 
function Urlcode(InpStr) 
Dim InpAsc,I 
For I = 1 To Len(InpStr) 
InpAsc = Asc(Mid(InpStr, I, 1)) 
If ((InpAsc < 58) And (InpAsc > 47)) Or ((InpAsc < 91) And (InpAsc > 64)) Or ((InpAsc < 123) And (InpAsc > 96)) Then 
Urlcode = Urlcode & Chr(InpAsc) 
Else 
Urlcode = Urlcode & "%" & mid(Trim(Hex(InpAsc)),1,2) & "%" & mid(Trim(Hex(InpAsc)),3,2) 
End If 
Next 
end Function