Visual Basic 以下簡稱(VB) 十一個功能強大的編程語言。特別是4.0 以后，支持了OLE Automation 技術，給編程帶來了更大的方便。前些時，我試著編寫一個支持網絡的數據庫。但是由于沒有聯網，所以沒法測試。于是，我想到了OLE Automation，用它就可以在一臺機器上測試網絡功能。經過改動，還可以用它通過Modem 來進行聯機。下面，我介紹一下如何用Visual Basic 編寫小型的網絡系統。
首先，建立一個支持網絡OLE Automation
啟動VB。在窗體Form1 中建立一個列表框List1，在它上面建一個Frame1，設置它的Caption 屬性為空。在它中間建立一個Label1，同樣，設置它的Caption 也為空。最后，在List1 上建立一個Caption 為UserList 的Label2。最后，把一個定時器Timer1 安上，把它的Interval 設為3000，Enabled 設為False 就行了。至此，NetWorkConnection 的窗體部分就完成了。
隨后，在VB 的Tools 菜單中選Options，按照填好各項內容。
接下來，在Insert 菜單中選取Module 建立一個新的模塊Module1。在(General) 中輸入填寫進下列代碼。
'(UserInfo數據類型)
Type UserInfo
Username As String
Alias As Integer
End Type
'(最大的用戶數)
Public Const MaxUser = 10
'(定義消息)
Public Const Msg_User_LogOn = 1
Public Const Msg_User_LogOff = 2
'(設定數據類型)
Public Users (MaxUser) As UserInfo
Public Inbox (MaxUser) As String
Public UserSystemInbox As Integer
Public Online(MaxUser) As Boolean
Sub main()
Form1.Show
End Sub
UserInfo 數據類型記錄了已經登錄的用戶的用戶名和別名。在顯示和通訊時只使用別名。用戶名只作為判斷用戶是否有效時用。出于安全考慮，以上數據用戶不能隨意訪問，必須通過下面的子程序來訪問。
在Insert菜單中選取Class Module 建立一個新的類Class1。更名為Common，并設置它的各個屬性。
填寫進下列代碼。
(提供獲取用戶ID 值的功能，用戶可以通過此功能使用別名來返回ID值)
Public Function GetUserID(Alias As String) As Integer
For i = 1 To MaxUser
If Users(i).Alias = Alias Then GetUserID = i
Next i
End Function
(提供獲得系統信息的功能。用戶可以通過它了解用戶是否有改動)
Public Function GetSystemMessage() As Integer
GetSystemMessage = UserSystemInbox
End Function
(提供獲得用戶信息的功能。用它來獲取所有在線用戶的別名，中間用"|"分開。)
Public Function GetUserInfo() As String
For i = 1 To MaxUser
If Users(i).Username < > "" Then
temp = temp + Users(i).Alias + "|"
End If
Next i
GetUserInfo = temp
End Function
(提供獲得用戶私有信息的功能。用來接受別的用戶發送的信息。)
Public Function GetUserMessage(ID As Integer) As String
If ID < = 0 Or ID > MaxUser Then
Exit Function
End If
GetUserMessage = Inbox(ID)
End Function
(提供注銷功能。用來退出網絡。)
Public Function LogOff(ID As Integer) As Boolean
If ID < = 0 Or ID > MaxUser Then
LogOff = False
Exit Function
End If
If Users(ID).Username < > "" Then
Users(ID).Username = ""
LogOff = True
Else
LogOff = False
End If
UserSystemInbox = Msg_User_LogOff
'-------------- Update Form1 ------------
For i = 0 To Form1.List1.ListCount - 1
If Form1.List1.List(i) = Users(ID).Alias Then
'查找List1中的用戶別名并刪除
Form1.List1.RemoveItem i
Exit For
End If
Next i
If Form1.List1.ListCount = 0 Then '如果沒有用戶登錄
Form1.Label1.Caption = "DisConnected"
Form1.timer1.Enabled = False
End If
End Function
(提供登錄功能來上網)
Public Function LogOn(Username As String, Alias As String) As Integer
For i = 1 To MaxUser
If Users(i).Username = "" Then
Users(i).Username = Username
Users(i).Alias = Alias
LogOn = i
UserSystemInbox = Msg_User_LogOn '發送"用戶登錄"信息
'-------------- Update Form1 ------------
Form1.List1.AddItem Alias '有用戶上網
Form1.Label1.Caption = "Connected"
Form1.timer1.Enabled = True
Exit Function
End If
Next i
LogOn = 0
End Function
(提供刷新用戶是否在線標志的功能。使系統能夠判斷你是否在線上，如果在6 秒內沒有調用此功能，系統將會把您自動刪除。)
Public Sub Refresh(ID As Integer)
If ID < = 0 Or ID > MaxUser Then Exit Sub
Online(ID) = True
End Sub
(提供發送用戶私有信息的功能。用來和其它用戶傳遞信息。)
Public Function SendUserMessage(Message As String, ToID As Integer) As Boolean
If ToID < = 0 Or ToID > MaxUser Then
SendUserMessage = False
Exit Function
End If
Inbox(ToID) = Message
SendUserMessage = True
End Function
在Form1 的Code 中輸入剩下的代碼。
'(初始化Form1)
Private Sub Form_Load()
Label1.Caption = "DisConnected"
Form1.Caption = "NetWork Connected Server"
Form1.Show
For i = 1 To MaxUser
Users(i).Username = ""
Next i
End Sub
(通過判斷Online 的值定時檢查用戶是否在線)
Private Sub timer1_Timer()
For i = 1 To MaxUser
If Users(i).Username < > "" Then
If Online(i) = False Then
For s = 0 To List1.ListCount - 1
If List1.List(s) = Users(i).Alias Then
List1.RemoveItem s
Users(i).Username = ""
UserSystemInbox = Msg_User_LogOff
'發送"用戶注銷"信息
End If
Next s
End If
Online(i) = False
End If
Next i
If List1.ListCount = 0 Then
'如果沒有用戶
Label1.Caption = "DisConnected"
timer1.Enabled = False
End If
End Sub
運行此程序。在啟動另一個VB，開始編寫用戶部分。在默認窗體中按下圖排好這些控件。
填入下列代碼
Public ID As Integer
Public Connected As Object
Private Sub Command1_Click() '登錄
Dim username As String
Dim alias As String
Set Connected = CreateObject("NetWorkConnection.Common") '啟動NetWorkConnection
username = Text1.Text
alias = Text2.Text
ID = Connected.logon(username, alias) '登錄并返回ID值
Timer1.Enabled = True
Command4_Click
End Sub
Private Sub Command2_Click() '注銷
x = Connected.logoff(ID)
Timer1.Enabled = False
Set x = Nothing '釋放對象
End Sub
Private Sub Command3_Click() '發送用戶信息
Dim TempID As Integer
Dim TempString As String
Dim x As String
Dim y As Boolean
x = Combo1.Text
TempID = Connected.getuserid(x) '獲得指定用戶的ID值
TempString = Text3.Text
y = Connected.sendusermessage(TempString, TempID)
End Sub
Private Sub Command4_Click()
For i = 0 To Combo1.ListCount 1 '清空Combo1
Combo1.RemoveItem 0
Next i
x = Connected.GetUserInfo '接收用戶信息
cd$ = x
lastst = 1
For i = 1 To Len(cd$)
If Mid$(cd$, i, 1) = "|" Then
Namef$ = Mid$(cd$, lastst, i - lastst)
Combo1.AddItem Namef$ '分離用戶別名并加入Combo1
lastst = i + 1
End If
Next i
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
Timer1.Interval = 300
End Sub
Private Sub Timer1_Timer()
Connected.Refresh (ID) '刷新用戶標志
x = Connected.GetSystemMessage() '接收系統信息
y = Connected.GetUserMessage(ID) '接收用戶信息
If y < > "" And y < > Label6.Caption Then Label6.Caption = y
If x < > Val(Label4.Caption) Then '刷新Combo1
Label4.Caption = x
Command4_Click
End If
End Sub
開始運行。輸入你的Username 和Alias，單擊Log On，查看一下先前的VB 范例，看看你的名字是否在內。如果是，證明你的" 集線器" 成功了。這時，不管已登錄的用戶處于什么原因沒有用LogOff 就中斷聯系，系統都會在6 秒后自動刪除這些用戶。確保其它用戶不受影響。
這個程序經過改動，可以給它支持Modem 的功能。而用戶部分的程序可以原封不動。編譯時在Options 中選中Remote Support File 并利用附帶的安裝程序安裝到網絡服務器上就可以真正實現" 聯網" 了。
延伸閱讀
文章來源于領測軟件測試網 http://www.kjueaiud.com/
