做個“網絡助手”程序

作者：土人

上網最麻煩的事莫過于在地址欄中輸入網址了。雖然有收藏夾幫忙，喜愛的網站多了它也日漸臃腫，占用資源不算，用起來也不是很方便。用VB做個“網絡助手”吧！
這個網絡助手至少要實現這樣的功能：雙擊用戶界面的網站名稱，就能調出瀏覽器并進入該網站。(當然，如果你愿意，還可以添加其它功能，如刪除、修改、添加網址，自動撥號，計時等)構想是這樣：用文本文檔記錄網站名稱，程序運行時讀取文本文檔并在用戶界面顯示網站名，當用戶雙擊網站名稱時調出網址、鏈接。
為此，著手編程之前我們必須做兩項準備工作：
一.用記事本編寫一個名為 homepage 的 TXT 文檔。每行寫一個網站名稱，不要有空行。
二.用數據庫程序 Aclearcase/" target="_blank" >ccess (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

至此，程序已經可以達成我們的目的了。

原文轉自：http://www.anti-gravitydesign.com