中國科大附中 徐 江


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 并利用附帶的安裝程序安裝到網絡服務器上就可以真正實現" 聯網" 了。