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=0OrIDMaxUserThen
　　ExitFunction
　　EndIf
　　GetUserMessage=Inbox(ID)
　　EndFunction
　　
　　----(提供注销功能。用来退出网络。)
　　
　　PublicFunctionLogOff(IDAsInteger)AsBoolean
　　IfID=0OrIDMaxUserThen
　　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=0OrIDMaxUserThenExitSub
　　Online(ID)=True
　　EndSub
　　
　　----(提供发送用户私有信息的功能。用来和其它用户传递信息。)
　　
　　PublicFunctionSendUserMessage(MessageAs
　　String,ToIDAsInteger)AsBoolean
　　IfToID=0OrToIDMaxUserThen
　　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""AndyLabel6.CaptionThenLabel6.Caption=y
　　IfxVal(Label4.Caption)Then`刷新Combo1
　　Label4.Caption=x
　　Command4_Click
　　EndIf
　　EndSub
　　
　　----开始运行。输入你的Username和Alias，单击LogOn，查看一下先前的VB范例，看看你的名字是否在内。如果是，证明你的"集线器"成功了。这时，不管已登录的用户处于什么原因没有用LogOff就中断联系，系统都会在6秒后自动删除这些用户。确保其它用户不受影响。
　　
　　----这个程序经过改动，可以给它支持Modem的功能。而用户部分的程序可以原封不动。编译时在Options中选中RemoteSupportFile并利用附带的安装程序安装到网络服务器上就可以真正实现"联网"了。->