如何用Visual Basic编写小型的网络系统
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
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