📄 datachat.vb
字号:
Imports System
Imports System.Configuration '因为用到了ConfigurationSettings类
Imports System.Web
Imports System.Text.RegularExpressions
'Imports Microsoft.VisualBasic
NameSpace nsChat 'nsChat为自己定义的名称空间的名称
'该类用来对发言信息进行各种处理
Public Class DataChat 'DataChat是自己定义的类的名称
'该过程用来添加某人大驾光临的信息
Public Sub UserCome(strUserId As String,strIP As String,strChatRoom As String)
'下面将该用户来到的信息保存到Application中
Dim strCome As String
strCome=DateTime.Now.ToShortTimeString & "<font color='red'>来自" & strIP & "的" & strUserId & "大驾光临</font>"
HttpContext.Current.Application.Lock '先锁定
HttpContext.Current.Application(strChatRoom) &= "<br>" & strCome
HttpContext.Current.Application.Unlock '解除锁定
End Sub
'该过程用来添加某人离去的信息
Public Sub UserGo(strUserId As String,strIP As String,strChatRoom As String)
'下面将该用户来到的信息保存到Application中
Dim strGo As String
strGo=DateTime.Now.ToShortTimeString & "<font color='red'>来自" & strIP & "的" & strUserId & "悄悄走了</font>"
HttpContext.Current.Application.Lock '先锁定
HttpContext.Current.Application(strChatRoom) &= "<br>" & strGo
HttpContext.Current.Application.Unlock '解除锁定
End Sub
'该过程用来添加一条普通发言信息
Public Sub AddSay(strUserId As String,strToWho As String,strSay As String,strSayColor As String,strNameColor As String,strEmote As String,strChatRoom As String)
'如果客户恰好输入了私聊标志【】〗,这里连续利用String类的Replace方法将其删除
strSay=strSay.Replace("【","").Replace("】","").Replace("〗","")
'如果是对"大家"说,则不添加对谁说,表示对所有人说
If strToWho="大家" Then
strToWho=""
Else
strToWho="对" & strToWho
End If
'下面将得到本次发言的字符串
Dim strTemp As String = DateTime.Now.ToShortTimeString & "<font color='" & strNameColor & "'>" & strUserId & "</font>" & strToWho & strEmote & "说:<font color='" & strSayColor & "'>" & strSay & "</font>"
'下面将该信息保存到Application中
HttpContext.Current.Application.Lock '先锁定
HttpContext.Current.Application(strChatRoom) &= "<br>" & strTemp
HttpContext.Current.Application.Unlock '解除锁定
End Sub
'该过程用来添加一条私聊信息
Public Sub AddPriSay(strUserId As String,strToWho As String,strSay As String,strSayColor As String,strNameColor As String,strEmote As String,strChatRoom As String)
'如果客户恰好输入了私聊标志【】〗,这里连续利用String类的Replace方法将其删除
strSay=strSay.Replace("【","").Replace("】","").Replace("〗","")
'下面将得到本次发言的字符串
Dim strTemp As String = DateTime.Now.ToShortTimeString & "<font color='" & strNameColor & "'>" & strUserId & "</font>" & strEmote & "对" & strToWho & "说:<font color='" & strSayColor & "'>" & strSay & "</font>"
'加上私聊标志
strTemp="【" & strUserId & "对" & strToWho & "】" & strTemp & "〗"
'下面将该信息保存到Application中
HttpContext.Current.Application.Lock '先锁定
HttpContext.Current.Application(strChatRoom) &= "<br>" & strTemp
HttpContext.Current.Application.Unlock '解除锁定
End Sub
'该函数用来返回自己可以看的发言信息,它会将不属于自己的私聊去掉
Public Function GetSay(strUserId As String,strChatRoom As String) As String
'首先读取聊天内容字符串
Dim strTemp As String=HttpContext.Current.Application(strChatRoom)
'下面利用正则表达式替换掉不属于自己的私聊信息
Dim myEvaluator As MatchEvaluator = New MatchEvaluator(AddressOf ReplaceCC) '首先定义一个MatchEvaluator 委托
strTemp=Regex.Replace(strTemp,"<br>【(?<UserId>\w*)对(?<ToWho>\w*)】(?<say>[^〗]*)〗",myEvaluator) '找到匹配项后就调用委托,并返回处理后的字符串
Return(strTemp) '返回处理后的字符串
End Function
'这是一个MatchEvaluator 委托,会返回当前匹配项处理后的私聊信息
Private Function ReplaceCC(m As Match) As String
If m.Groups("UserId").Value=HttpContext.Current.Session("UserId") Or m.Groups("ToWho").Value=HttpContext.Current.Session("UserId") Then
Return("<br>[悄悄]" & m.Groups("say").Value)
Else
Return("")
End If
End Function
'该过程用来清空指定聊天室的内容
Public Sub DeleteSay(strChatRoom As String)
HttpContext.Current.Application.Lock '先锁定
HttpContext.Current.Application(strChatRoom) = ""
HttpContext.Current.Application.Unlock '解除锁定
End Sub
End Class
End NameSpace
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -