1如何用Visual
Basic编写小型的网络系统
转载自中国程序员网站 (文/徐江)
----
Visual Basic 以 下 简 称(VB) 十 一 个 功 能 强 大 的
编 程 语 言。 特 别 是4.0 以 后, 支 持 了OLE
Automation 技 术, 给 编 程 带 来 了 更 大 的 方
便。 前 些 时, 我 试 着 编 写 一 个 支 持 网 络
的 数 据 库。 但 是 由 于 没 有 联 网, 所 以 没
法 测 试。 于 是, 我 想 到 了OLE Automation, 用 它
就 可 以 在 一 台 机 器 上 测 试 网 络 功 能。 经
过 改 动, 还 可 以 用 它 通 过Modem 来 进 行 联
机。 下 面, 我 介 绍 一 下 如 何 用Visual Basic 编
写 小 型 的 网 络 系 统。
首 先, 建 立 一 个 支 持 网 络OLE Automation
启 动VB。 在 窗 体Form1 中 建 立 一 个 列 表
框List 1, 在 它 上 面 建 一 个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, 单
击LogOn, 查 看 一 下 先 前 的VB 范 例, 看 看 你
的 名 字 是 否 在 内。 如 果 是, 证 明 你 的"
集 线 器" 成 功 了。 这 时, 不 管 已 登 录
的 用 户 处 于 什 么 原 因 没 有 用 LogOff 就 中 断
联 系, 系 统 都 会 在6 秒 后 自 动 删 除 这 些
用 。 确 保 其 它 用 户 不 受 影 响。
这 个 程 序 经 过 改 动, 可 以 给 它 支 持Modem
的 功 能。 而 用 户 部 分 的 程 序 可 以 原 封 不
动。 编 译 时 在Options 中 选 中Remote Support File 并
利 用 附 带 的 安 装 程 序 安 装 到 网 络 服 务
器 上 就 可 以 真 正 实 现" 联 网" 了。
|