用VB編寫小型的網(wǎng)絡(luò)系統(tǒng)
 

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

---- 隨 后， 在VB 的Tools 菜 單 中 選Options， 按 照 填 好 各 項 內(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

---- 運 行 此 程 序。 在 啟 動 另 一 個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

---- 開 始 運 行。 輸 入 你 的Username 和Alias， 單 擊LogOn， 查 看 一 下 先 前 的VB 范 例， 看 看 你 的 名 字 是 否 在 內(nèi)。 如 果 是， 證 明 你 的" 集 線 器" 成 功 了。 這 時， 不 管 已 登 錄 的 用 戶 處 于 什 么 原 因 沒 有 用 LogOff 就 中 斷 聯(lián) 系， 系 統(tǒng) 都 會 在6 秒 后 自 動 刪 除 這 些 用 戶。 確 保 其 它 用 戶 不 受 影 響。 
---- 這 個 程 序 經(jīng) 過 改 動， 可 以 給 它 支 持Modem 的 功 能。 而 用 戶 部 分 的 程 序 可 以 原 封 不 動。 編 譯 時 在Options 中 選 中Remote Support File 并 利 用 附 帶 的 安 裝 程 序 安 裝 到 網(wǎng) 絡(luò) 服 務(wù) 器 上 就 可 以 真 正 實 現(xiàn)" 聯(lián) 網(wǎng)" 了。