上网最麻烦的事莫过于在地址栏中输入网址了。虽然有收藏夹帮忙，喜爱的网站多了它也日渐臃肿，占用资源不算，用起来也不是很方便。用VB做个“网络助手”吧！
这个网络助手至少要实现这样的功能：双击用户界面的网站名称，就能调出浏览器并进入该网站。(当然，如果你愿意，还可以添加其它功能，如删除、修改、添加网址，自动拨号，计时等)构想是这样：用文本文档记录网站名称，程序运行时读取文本文档并在用户界面显示网站名，当用户双击网站名称时调出网址、链接。
为此，着手编程之前我们必须做两项准备工作：
一.用记事本编写一个名为 homepage 的 TXT 文档。每行写一个网站名称，不要有空行。
二.用数据库程序 Access (Office组件之一) 建立一个名为 address 的数据库，表名为 net，主字段名为 netaddress。给数据库输入记录：按照 homepage.txt 文档中的网站顺序写好各网站主页的详细网址，结束后存盘退出。
现在可以进入具体编程了。
这个程序所需控件不多：一个 data 控件，一个 ListBox 控件和一个 Label 控件即可。在属性窗口将 data 控件与库文件及其表链接好，并将 Label 控件与 Data 控件绑定。接着调整一下各控件的位置和大小。
下面是具体的代码，我将在代码中穿插作些必要的解释：
Option Explicit
'调用浏览器的API
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim Sort As String '申明选择类别
Dim address As String '申明网址
Dim addresslink '申明网址链接
Dim AllLines As New Collection '内存中的行数据库(你可以看得出来，模仿了"日积月累"的代码来实现对文档文档的读取和显示)
Dim CurrentLine As Long '当前行集合索引
'链接网址声明
Private Sub Link()
address = ShellExecute(0&, vbNullString, address, vbNullString, vbNullString, vbNormalFocus)
End Sub
'Form_Load 事件
Private Sub Form_Load()
Data1.DatabaseName = App.Path + "/address.mdb"
'定位库文件(虽然在属性中已经绑定了数据库，为使程序能在别的机器上正常运行，这行是有必要的)
Data1.RecordSource = "net" '字段
Data1.Visible = False 'data控件不可见
Dim nextLine As String '从文件中读出的每一行
Dim InFile As Integer '文件的描述符
InFile = FreeFile
Open App.Path + "/homepage.txt" For Input As InFile '打开文件
While Not EOF(InFile)
Line Input #InFile, nextLine
AllLines.Add nextLine
Wend
Close InFile
'将所有行集合按顺序添加到列表框
Dim i As Integer
For i = 0 To AllLines.Count - 1
GetNextLine
Next i
End Sub
'单击列表框
Private Sub List1_Click()
Dim Ind As Integer
Ind = List1.ListIndex
If Ind < Data1.Recordset.RecordCount Then
Data1.Recordset.AbsolutePosition = Ind
Else
Data1.Recordset.Move (Ind)
End If
address = Label1.Caption
End Sub
'双击列表框
Private Sub List1_dblClick()
Link
End Sub
'提取当前行
Public Sub GetCurrentLine()
If AllLines.Count > 0 Then
List1.AddItem AllLines.Item(CurrentLine)
End If
End Sub
'提取下一行
Private Sub GetNextLine()
CurrentLine = CurrentLine + 1
If AllLines.Count < CurrentLine Then
CurrentLine = 1
End If
GetCurrentLine
End Sub
至此，程序已经可以达成我们的目的了。如果需要添加其它功能，请参阅 VB编程乐园 的其它文章和源码自行补充。
|
