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