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并利用附带的安装程序安装到网络服务器上就可以真正实现"联网"了。->