当前位置: 首页 > 图文教程 > 脚本技术 > VBScript > vbs 百度小助手

VBScript
用vbs清空iis log 中自己登录ip的记录
vbs sendmail发邮件带附件方法
用vbs通过135端口执行命令的脚本
用vbs实现的瞬间关闭多个系统进程的脚本
vbs 中调用shell.application 简单函数
vbs wmi获取电脑硬件信息实例
用vbscript实现隐藏任务栏图标的脚本
vbs正则表达式代码
vbs版IP地理位置查询小偷
超级厉害的VBS定时提醒脚本 Remind.vbs
vbs实现的支持拖动的txt文本切割器
VBS如何察看或获得剪切板内容的脚本
VBS备忘录启动代码
VBS脚本使用WMI操作注册表的代码
vbs xmldom初次实战获取QQ签名的代码
VBS破坏性应用代码
vbs生成ACCESS数据里所有表的字段
vbs实现的图片自适应表格,目前最佳解决方案!
ProcessMagnifier.vbs进程查看
用于提取网易文件的hta代码

VBScript 中的 vbs 百度小助手


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2010-01-10   浏览: 200 ::
收藏到网摘: n/a

每天没事到百度上回答问题要先打开IE,输入BAIDU,点百度知道,点我要回答,再输入要回答的问题类别,很麻烦,于是写了这样一个百度小助手. 运行它直接选择:
1.我要回答;2.歌曲搜索;3,新闻搜索;4.网页搜索;5.贴吧搜索;6.知道搜索;7.图片搜索;8.视频搜索;9;百科搜索;
然后输入需要搜索的内容即可直接自动打开转到指定网址自动进行搜索.
复制代码 代码如下:

xz=InputBox("1.我要回答;2.歌曲搜索;3,新闻搜索;" & Chr(13) & "4.网页搜索;5.贴吧搜索;6.知道搜索;" & Chr(13) & "7.图片搜索;8.视频搜索;9;百科搜索;","百度小助手 [Null_vbt]","")
If Len(xz)=0 Then
MsgBox "没有选择,脚本退出!",64,"错误"
WScript.Quit
else
Select Case xz
Case 1
x=Urlcode(InputBox("请输入要回答的问题","百度我要回答",""))
If Len(x)=0 Then
MsgBox "没有检测到内容,脚本退出!",64,"错误"
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 "没有检测到内容,脚本退出!",64,"错误"
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("请输入要搜索的新闻标题","百度新闻搜索",""))
If Len(x)=0 Then
MsgBox "没有检测到内容,脚本退出!",64,"错误"
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("请输入要搜索的内容","百度网页搜索",""))
If Len(x)=0 Then
MsgBox "没有检测到内容,脚本退出!",64,"错误"
WScript.Quit
else
strurl="http://www.baidu.com/s?cl=3&wd=" & x
End if
Case 5
x=Urlcode(InputBox("请输入要搜索的贴子标题","百度贴吧搜索",""))
If Len(x)=0 Then
MsgBox "没有检测到内容,脚本退出!",64,"错误"
WScript.Quit
else
strurl="http://tieba.baidu.com/f?kw=" & x
End if
Case 6
x=InputBox("请输入要搜索的知道标题","百度知道搜索","")
If Len(x)=0 Then
MsgBox "没有检测到内容,脚本退出!",64,"错误"
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("请输入要搜索的图片标题","百度图片搜索",""))
If Len(x)=0 Then
MsgBox "没有检测到内容,脚本退出!",64,"错误"
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("请输入要搜索的视频标题","百度视频搜索",""))
If Len(x)=0 Then
MsgBox "没有检测到内容,脚本退出!",64,"错误"
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("请输入要搜索的百科标题","百度百科搜索",""))
If Len(x)=0 Then
MsgBox "没有检测到内容,脚本退出!",64,"错误"
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