defaultvb.aspx.vb

Telerik是很大的第三方软件制造商

Imports System
Imports System.Collections
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Web
Imports System.Web.SessionState
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.HtmlControls
Imports Telerik.QuickStart
Imports Telerik.WebControls


Namespace Telerik.CallbackExamplesVB.Demos.Chat
    '/ <summary>
    '/ Summary description for _Default.
    '/ </summary>

    Public Class DefaultVB
        Inherits XhtmlPage
        Protected userNamePanel As Panel
        Protected chatRoomPanel As Panel
        Protected chatBox As Label
        Protected message As Label
        Protected messageBox As System.Web.UI.WebControls.TextBox
        Protected userName As System.Web.UI.WebControls.TextBox
        Protected userNameHolder As System.Web.UI.WebControls.TextBox
        Protected usersList As ListBox
        Protected WithEvents sendButton As Telerik.WebControls.CallbackButton
        Protected WithEvents enterButton As Telerik.WebControls.CallbackButton
        Protected staticPanel As Panel
        Protected WithEvents timer1 As CallbackTimer


        Private Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
		End Sub	   'Page_Load

#Region "Web Form Designer generated code"

		Protected Overrides Sub OnInit(ByVal e As EventArgs)
			'
			' CODEGEN: This call is required by the ASP.NET Web Form Designer.
			'
			InitializeComponent()
			MyBase.OnInit(e)
		End Sub	   'OnInit


		'/ <summary>
		'/                  Required method for Designer support - do not modify
		'/                  the contents of this method with the code editor.
		'/ </summary>
		Private Sub InitializeComponent()

		End Sub	   'InitializeComponent

#End Region


		Private Sub enterButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles enterButton.Click
			If userName.Text.Trim() = String.Empty OrElse CheckUserName(userName.Text) Then
				message.Text = "Please, provide another username!<br>"
				Return
			End If
			userNamePanel.Style("display") = "none"
			chatRoomPanel.Style("display") = "block"
			Dim users As ArrayList = Nothing
			If Application("UsersListVB") Is Nothing Then
				users = New ArrayList
				Application.Add("UsersListVB", users)
			Else
				users = CType(Application("UsersListVB"), ArrayList)
			End If
			userNameHolder.Text = Guid.NewGuid().ToString()
			Session.Add(userNameHolder.Text, userName.Text)
			users.Add(New ChatUser(userName.Text))
			timer1.Start()
			PopulateUsers(users)
			Dim ctrl As Control
			For Each ctrl In staticPanel.Controls
				If TypeOf ctrl Is WebControl Then
					CType(ctrl, WebControl).Visible = True
				ElseIf TypeOf ctrl Is CallbackButton Then
					CType(ctrl, CallbackButton).Visible = True
				End If
			Next ctrl
		End Sub	   'enterButton_Click


		Private Sub sendButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles sendButton.Click
			chatBox.Text += String.Format("<span style=""color:blue""><b>{0}:</b> {1}</span><br>", CStr(Session(userNameHolder.Text)), messageBox.Text)
			Dim messages As ArrayList = Nothing
			If Application("MessagesVB") Is Nothing Then
				messages = New ArrayList
				Application.Add("MessagesVB", messages)
			Else
				messages = CType(Application("MessagesVB"), ArrayList)
			End If
			messages.Add(New ChatMessage(messageBox.Text, CStr(Session(userNameHolder.Text))))
			sendButton.ResponseScript = String.Format("var mb = document.getElementById('{0}'); mb.value=''; mb.focus();", messageBox.ClientID)
		End Sub	   'sendButton_Click


		Private Sub CallbackTimer1_Tick(ByVal sender As Object, ByVal args As System.EventArgs) Handles timer1.Tick
			Dim users As ArrayList = CType(Application("UsersListVB"), ArrayList)
			UpdateCurrentUser(users)
			If Not (Application("MessagesVB") Is Nothing) Then
				Dim messages As ArrayList = CType(Application("MessagesVB"), ArrayList)
				Dim i As Integer
				For i = messages.Count - 1 To 0 Step -1
					Dim message As ChatMessage = CType(messages(i), ChatMessage)
					If Not message.IsReadByUser(CStr(Session(userNameHolder.Text))) Then
						chatBox.Text += String.Format("<span style=""color:blue""><b>{0}:</b> {1}</span><br>", message.Author, message.MessageText)
						message.ReadByUsers.Add(CStr(Session(userNameHolder.Text)))
					End If
					If message.ReadByUsers.Count = users.Count Then
						messages.Remove(message)
					End If
				Next i
			End If
			CheckIdleUsers(users)
			CheckUsers(users)
		End Sub	   'CallbackTimer1_Tick

#Region "Private Helper Methods"

		Private Function CheckUserName(ByVal userName As String) As Boolean
			If Application("UsersList") Is Nothing Then
				Return False
			End If
			Dim users As ArrayList = CType(Application("UsersList"), ArrayList)
			If ChatUser.GetByUserName(users, userName) Is Nothing Then
				Return False
			End If
			Return True
		End Function	   'CheckUserName


		Private Sub UpdateCurrentUser(ByVal users As ArrayList)
			Dim currentUser As ChatUser = ChatUser.GetByUserName(users, CStr(Session(userNameHolder.Text)))
			If Not (currentUser Is Nothing) Then
				currentUser.LastAction = DateTime.Now
			End If
		End Sub	   'UpdateCurrentUser


		Private Sub PopulateUsers(ByVal users As ArrayList)
			Dim i As Integer
			For i = 0 To users.Count - 1
				Dim user As ChatUser = CType(users(i), ChatUser)
				usersList.Items.Add(New ListItem(user.UserName, user.UserName))
			Next i
		End Sub	   'PopulateUsers


		Private Sub RemoveUser(ByVal users As ArrayList, ByVal user As ChatUser)
			chatBox.Text += String.Format("<span style=""color:red"">User ""{0}"" left the room.</span><br>", user.UserName)
			usersList.Items.Remove(usersList.Items.FindByValue(user.UserName))
			users.Remove(user)
		End Sub	   'RemoveUser


		Private Function CheckUsers(ByVal users As ArrayList)
			Dim result As Boolean = False
			Dim i As Integer
			For i = 0 To users.Count - 1
				Dim user As ChatUser = CType(users(i), ChatUser)
				Dim userItem As ListItem = usersList.Items.FindByValue(user.UserName)
				If userItem Is Nothing Then
					result = True
					usersList.Items.Add(New ListItem(user.UserName, user.UserName))
					chatBox.Text += String.Format("<span style=""color:red"">User ""{0}"" joined the room.</span><br>", user.UserName)
				End If
			Next i
			Dim j As Integer
			For j = usersList.Items.Count - 1 To 0 Step -1
				Dim item As ListItem = usersList.Items(j)
				If ChatUser.GetByUserName(users, item.Value) Is Nothing Then
					chatBox.Text += String.Format("<span style=""color:red"">User ""{0}"" left the room.</span><br>", item.Value)
					usersList.Items.Remove(item)
				End If
			Next j
			Return result
		End Function	   'CheckUsers


		Private Sub CheckIdleUsers(ByVal users As ArrayList)
			Dim i As Integer
			For i = 0 To users.Count - 1
				Dim user As ChatUser = CType(users(i), ChatUser)
				Dim span As TimeSpan = DateTime.Now.Subtract(user.LastAction)
				If span.Seconds > 5 * 60 Then
					If span.Seconds > 10 * 60 Then
						RemoveUser(users, user)
						GoTo ContinueFor1
					End If
					Dim item As ListItem = usersList.Items.FindByValue(user.UserName)
					item.Text = user.UserName + " (idle)"
				Else
					Dim item As ListItem = usersList.Items.FindByValue(user.UserName)
					If Not (item Is Nothing) AndAlso item.Text.EndsWith(" (idle)") Then
						item.Text = item.Text.Substring(0, item.Text.Length - " (idle)".Length)
					End If
				End If
ContinueFor1:
			Next i
		End Sub	   'CheckIdleUsers
#End Region
	End Class	'controls

    Public Class ChatUser
        Public UserName As String = String.Empty
        Public LastAction As DateTime = DateTime.Now


        Public Sub New(ByVal userName As String)
            Me.UserName = userName
            Me.LastAction = DateTime.Now
        End Sub 'New


        Public Shared Function GetByUserName(ByVal users As ArrayList, ByVal userName As String) As ChatUser
            Dim i As Integer
            For i = 0 To users.Count - 1                
                Dim user As ChatUser = CType(users(i), ChatUser)
                If user.UserName = userName Then
                    Return user
                End If
            Next i
            Return Nothing
        End Function 'GetByUserName
    End Class 'ChatUser


    Public Class ChatMessage
        Public MessageText As String = String.Empty
        Public Author As String = String.Empty
        Public ReadByUsers As ArrayList = Nothing


        Public Sub New(ByVal messageText As String, ByVal userName As String)
            Me.MessageText = messageText
            Me.Author = userName
            Me.ReadByUsers = New ArrayList()
            ReadByUsers.Add(userName)
        End Sub 'New


        Public Function IsReadByUser(ByVal userName As String) As Boolean
            Dim i As Integer
            For i = 0 To ReadByUsers.Count - 1
                Dim user As String = CStr(ReadByUsers(i))
                If user = userName Then
                    Return True
                End If
            Next i
            Return False
        End Function 'IsReadByUser
    End Class 'ChatMessage
End Namespace