"
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) = "(北联网教程,专业提供视频软件下载)
……