如何用Visual Basic编写小型的网络系统
【打印文章】
中国科大附中 徐 江
Visual Basic 以下简称(VB) 十一个功能强大的编程语言。特别是4.0 以后，支持了OLE Automation 技术，给编程带来了更大的方便。前些时，我试着编写一个支持网络的数据库。但是由于没有联网，所以没法测试。于是，我想到了OLE Automation，用它就可以在一台机器上测试网络功能。经过改动，还可以用它通过Modem 来进行联机。下面，我介绍一下如何用Visual Basic 编写小型的网络系统。
首先，建立一个支持网络OLE Automation
启动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数据类型)
Type UserInfo
Username As String
Alias As Integer
End Type
'(最大的用户数)
Public Const MaxUser = 10
'(定义消息)
Public Const Msg_User_LogOn = 1
Public Const Msg_User_LogOff = 2
'(设定数据类型)
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 数据类型记录了已经登录的用户的用户名和别名。在显示和通讯时只使用别名。用户名只作为判断用户是否有效时用。出于安全考虑，以上数据用户不能随意访问，必须通过下面的子程序来访问。
在Insert菜单中选取Class Module 建立一个新的类Class1。更名为Common，并设置它的各个属性。
填写进下列代码。
(提供获取用户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
(提供获得系统信息的功能。用户可以通过它了解用户是否有改动)
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
(提供获得用户私有信息的功能。用来接受别的用户发送的信息。)
Public Function GetUserMessage(ID As Integer) As String
If ID < = 0 Or ID > MaxUser Then
Exit Function
End If
GetUserMessage = Inbox(ID)
End Function
(提供注销功能。用来退出网络。)
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
(提供登录功能来上网)
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 '发送"用户登录"信息
'-------------- Update Form1 ------------
Form1.List1.AddItem Alias '有用户上网
Form1.Label1.Caption = "Connected"
Form1.timer1.Enabled = True
Exit Function
End If
Next i
LogOn = 0
End Function
(提供刷新用户是否在线标志的功能。使系统能够判断你是否在线上，如果在6 秒内没有调用此功能，系统将会把您自动删除。)
Public Sub Refresh(ID As Integer)
If ID < = 0 Or ID > MaxUser Then Exit Sub
Online(ID) = True
End Sub
(提供发送用户私有信息的功能。用来和其它用户传递信息。)
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
'发送"用户注销"信息
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，开始编写用户部分。在默认窗体中按下图排好这些控件。
填入下列代码
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() '发送用户信息
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) '刷新用户标志
x = Connected.GetSystemMessage() '接收系统信息
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，单击Log On，查看一下先前的VB 范例，看看你的名字是否在内。如果是，证明你的" 集线器" 成功了。这时，不管已登录的用户处于什么原因没有用LogOff 就中断联系，系统都会在6 秒后自动删除这些用户。确保其它用户不受影响。
这个程序经过改动，可以给它支持Modem 的功能。而用户部分的程序可以原封不动。编译时在Options 中选中Remote Support File 并利用附带的安装程序安装到网络服务器上就可以真正实现" 联网" 了。
Visual Basic 以下简称(VB) 十一个功能强大的编程语言。特别是4.0 以后，支持了OLE Automation 技术，给编程带来了更大的方便。前些时，我试着编写一个支持网络的数据库。但是由于没有联网，所以没法测试。于是，我想到了OLE Automation，用它就可以在一台机器上测试网络功能。经过改动，还可以用它通过Modem 来进行联机。下面，我介绍一下如何用Visual Basic 编写小型的网络系统。
首先，建立一个支持网络OLE Automation
启动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数据类型)
Type UserInfo
Username As String
Alias As Integer
End Type
'(最大的用户数)
Public Const MaxUser = 10
'(定义消息)
Public Const Msg_User_LogOn = 1
Public Const Msg_User_LogOff = 2
'(设定数据类型)
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 数据类型记录了已经登录的用户的用户名和别名。在显示和通讯时只使用别名。用户名只作为判断用户是否有效时用。出于安全考虑，以上数据用户不能随意访问，必须通过下面的子程序来访问。
在Insert菜单中选取Class Module 建立一个新的类Class1。更名为Common，并设置它的各个属性。
填写进下列代码。
(提供获取用户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
(提供获得系统信息的功能。用户可以通过它了解用户是否有改动)
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
(提供获得用户私有信息的功能。用来接受别的用户发送的信息。)
Public Function GetUserMessage(ID As Integer) As String
If ID < = 0 Or ID > MaxUser Then
Exit Function
End If
GetUserMessage = Inbox(ID)
End Function
(提供注销功能。用来退出网络。)
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
(提供登录功能来上网)
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 '发送"用户登录"信息
'-------------- Update Form1 ------------
Form1.List1.AddItem Alias '有用户上网
Form1.Label1.Caption = "Connected"
Form1.timer1.Enabled = True
Exit Function
End If
Next i
LogOn = 0
End Function
(提供刷新用户是否在线标志的功能。使系统能够判断你是否在线上，如果在6 秒内没有调用此功能，系统将会把您自动删除。)
Public Sub Refresh(ID As Integer)
If ID < = 0 Or ID > MaxUser Then Exit Sub
Online(ID) = True
End Sub
(提供发送用户私有信息的功能。用来和其它用户传递信息。)
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
'发送"用户注销"信息
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，开始编写用户部分。在默认窗体中按下图排好这些控件。
填入下列代码
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() '发送用户信息
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) '刷新用户标志
x = Connected.GetSystemMessage() '接收系统信息
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，单击Log On，查看一下先前的VB 范例，看看你的名字是否在内。如果是，证明你的" 集线器" 成功了。这时，不管已登录的用户处于什么原因没有用LogOff 就中断联系，系统都会在6 秒后自动删除这些用户。确保其它用户不受影响。
这个程序经过改动，可以给它支持Modem 的功能。而用户部分的程序可以原封不动。编译时在Options 中选中Remote Support File 并利用附带的安装程序安装到网络服务器上就可以真正实现" 联网" 了。
本栏文章均来自于互联网，版权归原作者和各发布网站所有，本站收集这些文章仅供学习参考之用。任何人都不能将这些文章用于商业或者其他目的。( Pfan.cn )
【编程爱好者论坛】