中國科大附中 徐 江


Visual Basic 以下簡稱(VB) 十一個功能強(qiáng)大的編程語言。特別是4.0 以后，支持了OLE Automation 技術(shù)，給編程帶來了更大的方便。前些時，我試著編寫一個支持網(wǎng)絡(luò)的數(shù)據(jù)庫。但是由于沒有聯(lián)網(wǎng)，所以沒法測試。于是，我想到了OLE Automation，用它就可以在一臺機(jī)器上測試網(wǎng)絡(luò)功能。經(jīng)過改動，還可以用它通過Modem 來進(jìn)行聯(lián)機(jī)。下面，我介紹一下如何用Visual Basic 編寫小型的網(wǎng)絡(luò)系統(tǒng)。

首先，建立一個支持網(wǎng)絡(luò)OLE Automation

啟動VB。在窗體Form1 中建立一個列表框List1，在它上面建一個Frame1，設(shè)置它的Caption 屬性為空。在它中間建立一個Label1，同樣，設(shè)置它的Caption 也為空。最后，在List1 上建立一個Caption 為UserList 的Label2。最后，把一個定時器Timer1 安上，把它的Interval 設(shè)為3000，Enabled 設(shè)為False 就行了。至此，NetWorkConnection 的窗體部分就完成了。

隨后，在VB 的Tools 菜單中選Options，按照填好各項(xiàng)內(nèi)容。

接下來，在Insert 菜單中選取Module 建立一個新的模塊Module1。在(General) 中輸入填寫進(jìn)下列代碼。


'(UserInfo數(shù)據(jù)類型)

Type UserInfo

Username As String

Alias As Integer

End Type

'(最大的用戶數(shù))

Public Const MaxUser = 10

'(定義消息)

Public Const Msg_User_LogOn = 1

Public Const Msg_User_LogOff = 2

'(設(shè)定數(shù)據(jù)類型)

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 數(shù)據(jù)類型記錄了已經(jīng)登錄的用戶的用戶名和別名。在顯示和通訊時只使用別名。用戶名只作為判斷用戶是否有效時用。出于安全考慮，以上數(shù)據(jù)用戶不能隨意訪問，必須通過下面的子程序來訪問。

在Insert菜單中選取Class Module 建立一個新的類Class1。更名為Common，并設(shè)置它的各個屬性。

填寫進(jìn)下列代碼。

(提供獲取用戶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


(提供獲得系統(tǒng)信息的功能。用戶可以通過它了解用戶是否有改動)


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


(提供獲得用戶私有信息的功能。用來接受別的用戶發(fā)送的信息。)


Public Function GetUserMessage(ID As Integer) As String

If ID < = 0 Or ID > MaxUser Then

Exit Function

End If

GetUserMessage = Inbox(ID)

End Function


(提供注銷功能。用來退出網(wǎng)絡(luò)。)


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


(提供登錄功能來上網(wǎng))


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 '發(fā)送"用戶登錄"信息

'-------------- Update Form1 ------------

Form1.List1.AddItem Alias '有用戶上網(wǎng)

Form1.Label1.Caption = "Connected"

Form1.timer1.Enabled = True

Exit Function

End If

Next i

LogOn = 0

End Function


(提供刷新用戶是否在線標(biāo)志的功能。使系統(tǒng)能夠判斷你是否在線上，如果在6 秒內(nèi)沒有調(diào)用此功能，系統(tǒng)將會把您自動刪除。)


Public Sub Refresh(ID As Integer)

If ID < = 0 Or ID > MaxUser Then Exit Sub

Online(ID) = True

End Sub


(提供發(fā)送用戶私有信息的功能。用來和其它用戶傳遞信息。)


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

'發(fā)送"用戶注銷"信息

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


運(yùn)行此程序。在啟動另一個VB，開始編寫用戶部分。在默認(rèn)窗體中按下圖排好這些控件。


填入下列代碼


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() '發(fā)送用戶信息

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) '刷新用戶標(biāo)志

x = Connected.GetSystemMessage() '接收系統(tǒng)信息

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


開始運(yùn)行。輸入你的Username 和Alias，單擊Log On，查看一下先前的VB 范例，看看你的名字是否在內(nèi)。如果是，證明你的" 集線器" 成功了。這時，不管已登錄的用戶處于什么原因沒有用LogOff 就中斷聯(lián)系，系統(tǒng)都會在6 秒后自動刪除這些用戶。確保其它用戶不受影響。

這個程序經(jīng)過改動，可以給它支持Modem 的功能。而用戶部分的程序可以原封不動。編譯時在Options 中選中Remote Support File 并利用附帶的安裝程序安裝到網(wǎng)絡(luò)服務(wù)器上就可以真正實(shí)現(xiàn)" 聯(lián)網(wǎng)" 了。