VB-2.1

VB-2.1
2011年09月26日
　　 Option Explicit
　　Dim seaid As Integer
　　Dim id1 As Integer
　　Dim txt As String
　　Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameter As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
　　Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
　　Private Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
　　Private r As Long
　　Private entry As String
　　Private iniPath As String
　　Function GetFormINI(AppName As String, KeyName As String, FileName As String) As String
　　Dim RetStr As String
　　RetStr = String(255, Chr(0))
　　GetFormINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), FileName))
　　End Function
　　Private Sub Combo1_Click()
　　seaid = Combo1.ListIndex    'seaid为目前combobox现行选中项
　　WritePrivateProfileString "配置设置", "seaid", CStr(seaid), iniPath
　　If seaid = 0 Then
　　Option1.Caption = "新闻"
　　Option2.Caption = "网页"
　　Option3.Caption = "贴吧"
　　Option4.Caption = "知道"
　　Option5.Caption = "音乐"
　　Option6.Caption = "图片"
　　Option7.Caption = "视频"
　　Option8.Caption = "地图"
　　Option9.Caption = "百科"
　　Option10.Caption = "文库"
　　Option11.Caption = "词典"
　　ElseIf seaid = 1 Then
　　Option1.Caption = "新闻"
　　Option2.Caption = "网页"
　　Option3.Caption = "购物"
　　Option4.Caption = "学术"
　　Option5.Caption = "音乐"
　　Option6.Caption = "图片"
　　Option7.Caption = "视频"
　　Option8.Caption = "地图"
　　Option9.Caption = "翻译"
　　Option10.Caption = "图书"
　　Option11.Caption = "Code"
　　ElseIf seaid = 2 Then
　　'此处加入其他选中项时显示的相关内容
　　End If
　　If id1 = 1 Then
　　Option1_Click
　　ElseIf id1 = 2 Then
　　Option2_Click
　　ElseIf id1 = 3 Then
　　Option3_Click
　　ElseIf id1 = 4 Then
　　Option4_Click
　　ElseIf id1 = 5 Then
　　Option5_Click
　　ElseIf id1 = 6 Then
　　Option6_Click
　　ElseIf id1 = 7 Then
　　Option7_Click
　　ElseIf id1 = 8 Then
　　Option8_Click
　　ElseIf id1 = 9 Then
　　Option9_Click
　　ElseIf id1 = 10 Then
　　Option10_Click
　　ElseIf id1 = 11 Then
　　Option11_Click
　　End If
　　End Sub
　　Public Function UTF8Encode(ByVal szInput As String) As String '此函数将汉字转换成UTF8编码
　　Dim wch As String
　　Dim uch As String
　　Dim szRet As String
　　Dim x As Long
　　Dim inputLen As Long
　　Dim nAsc As Long
　　Dim nAsc2 As Long
　　Dim nAsc3 As Long
　　If szInput = "" Then
　　UTF8Encode = szInput
　　Exit Function
　　End If
　　inputLen = Len(szInput)
　　For x = 1 To inputLen
　　wch = Mid(szInput, x, 1)
　　nAsc = AscW(wch)
　　If nAsc  "" Then
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://news.baidu.com/ns?word=" + Text1.Text
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.com.hk/search?hl=zh-CN&gl=cn&tbm=nws&btnmeta_news_search=1&q=" + txt
　　End If
　　Else
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://news.baidu.com/"
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://news.google.com/"
　　End If
　　End If
　　id1 = 1
　　WritePrivateProfileString "配置设置", "id1", CStr(id1), iniPath
　　End Sub
　　Private Sub Option10_Click() '文库
　　If Text1.Text  "" Then
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://wenku.baidu.com/search?word=" + Text1.Text
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.com.hk/search?q=" + txt + "&btnG=%E6%90%9C%E7%B4%A2%E5%9B%BE%E4%B9%A6&tbm=bks&tbo=1&hl=zh-CN"
　　End If
　　Else
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://wenku.baidu.com/"
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://books.google.com.hk/books?hl=zh-CN"
　　End If
　　End If
　　id1 = 10
　　WritePrivateProfileString "配置设置", "id1", CStr(id1), iniPath
　　End Sub
　　Private Sub Option11_Click() '词典
　　If Text1.Text  "" Then
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://dict.baidu.com/s?wd=" + Text1.Text
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://code.google.com/intl/zh-CN/query/#q=" + txt
　　End If
　　Else
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://dict.baidu.com/s?wd=" + Text1.Text
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://code.google.com/intl/zh-CN/"
　　End If
　　End If
　　id1 = 11
　　WritePrivateProfileString "配置设置", "id1", CStr(id1), iniPath
　　End Sub
　　Private Sub Option2_Click() '新闻
　　If Text1.Text  "" Then
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://www.baidu.com/s?wd=" + Text1.Text
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.com.hk/webhp?hl=zh-CN&source=hp#hl=zh-CN&source=hp&q=" + txt
　　End If
　　Else
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://www.baidu.com/"
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.com.hk/"
　　End If
　　End If
　　id1 = 2
　　WritePrivateProfileString "配置设置", "id1", CStr(id1), iniPath
　　End Sub
　　Private Sub Option3_Click() '贴吧
　　If Text1.Text  "" Then
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://tieba.baidu.com/f?kw=" + Text1.Text
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.cn/products?q=" + txt
　　End If
　　Else
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://tieba.baidu.com/"
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.cn/prdhp?hl=zh-CN&tab=ff"
　　End If
　　End If
　　id1 = 3
　　WritePrivateProfileString "配置设置", "id1", CStr(id1), iniPath
　　End Sub
　　Private Sub Option4_Click() '知道
　　If Text1.Text  "" Then
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://zhidao.baidu.com/q?word=" + Text1.Text + "&ct=17&pn=0&tn=ikaslist&rn=10&lm=0&fr=search"
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://scholar.google.com.hk/scholar?q=" + txt
　　End If
　　Else
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://zhidao.baidu.com/"
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://scholar.google.com.hk/schhp?hl=zh-CN&as_sdt=0,5"
　　End If
　　End If
　　id1 = 4
　　WritePrivateProfileString "配置设置", "id1", CStr(id1), iniPath
　　End Sub
　　Private Sub Option5_Click() '音乐
　　If Text1.Text  "" Then
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://mp3.baidu.com/m?f=ms&rf=idx&tn=baidump3&ct=134217728&lf=&rn=&word=" + Text1.Text
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.cn/music/search?q=" + txt
　　End If
　　Else
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://mp3.baidu.com/"
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.cn/music/"
　　End If
　　End If
　　id1 = 5
　　WritePrivateProfileString "配置设置", "id1", CStr(id1), iniPath
　　End Sub
　　Private Sub Option6_Click() '图片
　　If Text1.Text  "" Then
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://image.baidu.com/i?ct=201326592&cl=2&lm=-1&tn=baiduimage&istype=2&fm=index&pv=&z=0&word=" + Text1.Text
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.com.hk/search?tbm=isch&hl=zh-CN&source=hp&biw=1366&bih=573&q=" + txt
　　End If
　　Else
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://image.baidu.com/"
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.com.hk/imghp?hl=zh-CN&tab=wi"
　　End If
　　End If
　　id1 = 6
　　WritePrivateProfileString "配置设置", "id1", CStr(id1), iniPath
　　End Sub
　　Private Sub Option7_Click() '视频
　　If Text1.Text  "" Then
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://video.baidu.com/v?word=" + Text1.Text
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.com.hk/search?q=" + txt + "&tbo=p&tbm=vid&source=vgc&hl=zh-CN&aq=f"
　　End If
　　Else
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://video.baidu.com/"
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://www.google.com.hk/videohp?hl=zh-CN&tab=wv"
　　End If
　　End If
　　id1 = 7
　　WritePrivateProfileString "配置设置", "id1", CStr(id1), iniPath
　　End Sub
　　Private Sub Option8_Click() '地图
　　If Text1.Text  "" Then
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://map.baidu.com/?newmap=1&ie=utf-8&s=s%26wd%3D" + Text1.Text
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://ditu.google.cn/maps?q=" + txt
　　End If
　　Else
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://map.baidu.com/"
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://ditu.google.cn/"
　　End If
　　End If
　　id1 = 8
　　WritePrivateProfileString "配置设置", "id1", CStr(id1), iniPath
　　End Sub
　　Private Sub Option9_Click() '百科
　　If Text1.Text  "" Then
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://baike.baidu.com/notexists?word=" + Text1.Text
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://translate.google.cn/?q=" + txt
　　End If
　　Else
　　If seaid = 0 Then
　　WebBrowser1.Navigate "http://baike.baidu.com/"
　　ElseIf seaid = 1 Then
　　WebBrowser1.Navigate "http://translate.google.cn/"
　　End If
　　End If
　　id1 = 9
　　WritePrivateProfileString "配置设置", "id1", CStr(id1), iniPath
　　End Sub
　　Private Sub Text1_Change()
　　txt = UTF8Encode(Text1.Text)
　　End Sub
　　Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
　　If KeyCode = 13 Then
　　If id1 = 1 Then
　　Call Option1_Click
　　ElseIf id1 = 2 Then
　　Call Option2_Click
　　ElseIf id1 = 2 Then
　　Call Option2_Click
　　ElseIf id1 = 3 Then
　　Call Option3_Click
　　ElseIf id1 = 4 Then
　　Call Option4_Click
　　ElseIf id1 = 5 Then
　　Call Option5_Click
　　ElseIf id1 = 6 Then
　　Call Option6_Click
　　ElseIf id1 = 7 Then
　　Call Option7_Click
　　ElseIf id1 = 8 Then
　　Call Option8_Click
　　ElseIf id1 = 9 Then
　　Call Option9_Click
　　ElseIf id1 = 10 Then
　　Call Option10_Click
　　ElseIf id1 = 11 Then
　　Call Option11_Click
　　End If
　　End If
　　End Sub