VisualBasic以下簡稱(VB)十一個功能強大的編程語言。特別是4.0以後，支持了OLEAutomation技術，給編程帶來了更大的方便。前些時，我試著編寫一個支持網絡的數據庫。但是由於沒有聯網，所以沒法測試。於是，我想到了OLEAutomation，用它就可以在一台機器上測試網絡功能。經過改動，還可以用它通過Modem來進行聯機。下面，我介紹一下如何用VisualBasic編寫小型的網絡系統。
----首先，建立一個支持網絡OLEAutomation
----啟動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數據類型)
TypeUserInfo
UsernameAsString
AliasAsInteger
EndType
(最大的用戶數)
PublicConstMaxUser=10
(定義消息)
PublicConstMsg_User_LogOn=1
PublicConstMsg_User_LogOff=2
(設定數據類型)
PublicUsers(MaxUser)AsUserInfo
PublicInbox(MaxUser)AsString
PublicUserSystemInboxAsInteger
PublicOnline(MaxUser)AsBoolean
Submain()
Form1.Show
EndSub
----UserInfo數據類型記錄了已經登錄的用戶的用戶名和別名。在顯示和通訊時只使用別名。用戶名只作為判斷用戶是否有效時用。出於安全考慮，以上數據用戶不能隨意訪問，必須通過下面的子程序來訪問。
----在Insert菜單中選取ClassModule建立一個新的類Class1。更名為Common，並設置它的各個屬性。
----填寫進下列代碼。
----(提供獲取用戶ID值的功能，用戶可以通過此功能使用別名來返回ID值)
PublicFunctionGetUserID(AliasAsString)AsInteger
ForI=1ToMaxUser
IfUsers(I).Alias=AliasThenGetUserID=I
NextI
EndFunction
----(提供獲得系統信息的功能。用戶可以通過它了解用戶是否有改動)
PublicFunctionGetSystemMessage()AsInteger
GetSystemMessage=UserSystemInbox
EndFunction
----(提供獲得用戶信息的功能。用它來獲取所有在線用戶的別名，中間用"|"分開。)
PublicFunctionGetUserInfo()AsString
ForI=1ToMaxUser
IfUsers(I).Username<>""Then
temp=temp Users(I).Alias "|"
EndIf
NextI
GetUserInfo=temp
EndFunction
----(提供獲得用戶私有信息的功能。用來接受別的用
戶發送的信息。)
PublicFunctionGetUserMessage(IDAsInteger)AsString
IfID<=0OrID>MaxUserThen
ExitFunction
EndIf
GetUserMessage=Inbox(ID)
EndFunction
----(提供注銷功能。用來退出網絡。)
PublicFunctionLogOff(IDAsInteger)AsBoolean
IfID<=0OrID>MaxUserThen
LogOff=False
ExitFunction
EndIf
IfUsers(ID).Username<>""Then
Users(ID).Username=""
LogOff=True
Else
LogOff=False
EndIf
UserSystemInbox=Msg_User_LogOff
`--------------UpdateForm1------------
ForI=0ToForm1.List1.ListCount-1
IfForm1.List1.List(I)=Users(ID).AliasThen
`查找List1中的用戶別名並刪除
Form1.List1.RemoveItemI
ExitFor
EndIf
NextI
IfForm1.List1.ListCount=0Then`如果沒有用戶登錄
Form1.Label1.Caption="DisConnected"
Form1.timer1.Enabled=False
EndIf
EndFunction
----(提供登錄功能來上網)
PublicFunctionLogOn(UsernameAsString,
AliasAsString)AsInteger
ForI=1ToMaxUser
IfUsers(I).Username=""Then
Users(I).Username=Username
Users(I).Alias=Alias
LogOn=I
UserSystemInbox=Msg_User_LogOn`發送"用戶登錄"信息
`--------------UpdateForm1------------
Form1.List1.AddItemAlias`有用戶上網
Form1.Label1.Caption="Connected"
Form1.timer1.Enabled=True
ExitFunction
EndIf
NextI
LogOn=0
EndFunction
----(提供刷新用戶是否在線標志的功能。使系統能夠判斷你是否在線上，如果在6秒內沒有調用此功能，系統將會把您自動刪除。)
PublicSubRefresh(IDAsInteger)
IfID<=0OrID>MaxUserThenExitSub
Online(ID)=True
EndSub
----(提供發送用戶私有信息的功能。用來和其它用戶傳遞信息。)
PublicFunctionSendUserMessage(MessageAs
String,ToIDAsInteger)AsBoolean
IfToID<=0OrToID>MaxUserThen
SendUserMessage=False
ExitFunction
EndIf
Inbox(ToID)=Message
SendUserMessage=True
EndFunction
----在Form1的Code中輸入剩下的代碼。
(初始化Form1)
PrivateSubForm_Load()
Label1.Caption="DisConnected"
Form1.Caption="NetWorkConnectedServer"
Form1.Show
ForI=1ToMaxUser
Users(I).Username=""
NextI
EndSub
----(通過判斷Online的值定時檢查用戶是否在線)
PrivateSubtimer1_Timer()
ForI=1ToMaxUser
IfUsers(I).Username<>""Then
IfOnline(I)=FalseThen
Fors=0ToList1.ListCount-1
IfList1.List(s)=Users(I).AliasThen
List1.RemoveItems
Users(I).Username=""
UserSystemInbox=Msg_User_LogOff
`發送"用戶注銷"信息
EndIf
Nexts
EndIf
Online(I)=False
EndIf
NextI
IfList1.ListCount=0Then
`如果沒有用戶
Label1.Caption="DisConnected"
timer1.Enabled=False
EndIf
EndSub
----運行此程序。在啟動另一個VB，開始編寫用戶部分。在默認窗體中按下圖排好這些控件。
----填入下列代碼
PublicIDAsInteger
PublicConnectedAsObject
PrivateSubCommand1_Click()`登錄
DimusernameAsString
DimaliasAsString
SetConnected=CreateObject
("NetWorkConnection.Common")啟動NetWorkConnection
username=Text1.Text
alias=Text2.Text
ID=Connected.Logon(username,alias)`登錄並返回ID值
Timer1.Enabled=True
Command4_Click
EndSub
PrivateSubCommand2_Click()`注銷
x=Connected.Logoff(ID)
Timer1.Enabled=False
Setx=Nothing`釋放對象
EndSub
PrivateSubCommand3_Click()`發送用戶信息
DimTempIDAsInteger
DimTempStringAsString
DimxAsString
DimyAsBoolean
x=Combo1.Text
TempID=Connected.getuserid(x)`獲得指定用戶的ID值
TempString=Text3.Text
y=Connected.sendusermessage(TempString,TempID)
EndSub
PrivateSubCommand4_Click()
ForI=0ToCombo1.ListCount1`清空Combo1
Combo1.RemoveItem0
NextI
x=Connected.GetUserInfo`接收用戶信息
cd$=x
lastst=1
ForI=1ToLen(cd$)
IfMid$(cd$,I,1)="|"Then
Namef$=Mid$(cd$,lastst,I-lastst)
Combo1.AddItemNamef$`分離用戶別名並加入Combo1
lastst=I 1
EndIf
NextI
EndSub
PrivateSubForm_Load()
Timer1.Enabled=False
Timer1.Interval=300
EndSub
PrivateSubTimer1_Timer()
Connected.Refresh(ID)`刷新用戶標志
x=Connected.GetSystemMessage()`接收系統信息
y=Connected.GetUserMessage(ID)`接收用戶信息
Ify<>""Andy<>Label6.CaptionThenLabel6.Caption=y
Ifx<>Val(Label4.Caption)Then`刷新Combo1
Label4.Caption=x
Command4_Click
EndIf
EndSub
----開始運行。輸入你的Username和Alias，單擊LogOn，查看一下先前的VB范例，看看你的名字是否在內。如果是，證明你的"集線器"成功了。這時，不管已登錄的用戶處於什麼原因沒有用LogOff就中斷聯系，系統都會在6秒後自動刪除這些用戶。確保其它用戶不受影響。
----這個程序經過改動，可以給它支持Modem的功能。而用戶部分的程序可以原封不動。編譯時在Options中選中RemoteSupportFile並利用附帶的安裝程序安裝到網絡服務器上就可以真正實現"聯網"了。->
