'*****************************************************
' 这是函数文件，保存其它页面用到的函数
'*****************************************************
'该函数返回姓名颜色
Function GetNameColor(namecolor)
Select Case namecolor
Case "0"
GetNameColor="#008888"
Case "1"
GetNameColor="#000000"
Case "2"
GetNameColor="#0088FF"
Case "3"
GetNameColor="#0000FF"
Case "4"
GetNameColor="#000088"
Case "5"
GetNameColor="#888800"
Case "6"
GetNameColor="#008888"
Case "7"
GetNameColor="#008800"
Case "8"
GetNameColor="#8888FF"
Case "9"
GetNameColor="#AA00CC"
Case "10"
GetNameColor="#8800FF"
Case else
GetNameColor="#008888"
End Select
End Function
'该函数返回说话颜色
Function GetSaysColor(sayscolor)
Select Case sayscolor
Case "0"
GetSaysColor="#660099"
Case "1"
GetSaysColor="#000000"
Case "2"
GetSaysColor="#0088FF"
Case "3"
GetSaysColor="#0000FF"
Case "4"
GetSaysColor="#000088"
Case "5"
GetSaysColor="#888800"
Case "6"
GetSaysColor="#008888"
Case "7"
GetSaysColor="#008800"
Case "8"
GetSaysColor="#8888FF"
Case "9"
GetSaysColor="#AA00CC"
Case "10"
GetSaysColor="#8800FF"
Case else
GetSaysColor="#660099"
End Select
End Function
'该函数返回表情
Function GetEmote(emote)
Select Case emote
Case "0"
GetEmote=""
Case "1"
GetEmote="微微笑"
Case "2"
GetEmote="温柔地"
Case "3"
GetEmote="红着脸"
Case "4"
GetEmote="摇头晃脑得意地"
Case "5"
GetEmote="哈！哈！哈！笑着"
Case "6"
GetEmote="神秘兮兮地"
Case "7"
GetEmote="战战兢兢地"
Case "8"
GetEmote="毛手毛脚地"
Case "9"
GetEmote="嘟着嘴地"
Case "10"
GetEmote="慢条斯理地"
End Select
End Function
'该函数用来判断该用户名是否被使用,存在返回True，不存在返回False
Function GetUserName(username,chatroom)
Dim arrayUsername,I
arrayUsername=Application(chatroom & "_arrayUsername")
'如果IsArray(arrayUserName)=True，表示在线用户名单是数组，说明有在线人员，可以查找
'否则表示根本没有人在线，不必查找，直接返回False即可
If IsArray(arrayUserName)=True Then
For I=0 To Ubound(arrayUsername)
If username=arrayUsername(I) Then
'条件成立，表示找到该用户名，所以返回True，并结束函数
GetUserName=True
Exit Function
End IF
Next
Else
GetUserName=False
End If
End Function
'该子程序用来将该用户加入在线用户列表
Sub AddUserName(username,chatroom)
'首先判断一下该用户是否存在，如果不存在则继续添加
If GetUserName(username,chatroom)=False Then
Dim arrayUsername,numTemp,I
arrayUsername=Application(chatroom & "_arrayUsername")
'此时要分两种情况
If IsArray(arrayUsername)=False Then
'如果条件成立，表示此时根本还不是数组，说明是第一个人访问，所以定义一个新的数组，并将该用户添加进去即可。
Dim arrayNew(0)
arrayNew(0)=username '保存用户名
Application.Lock
Application(chatroom & "_arrayUserName")=arrayNew
Application.Unlock
Else
'条件不成立，表示已经有人在线，只要将其添加在后面即可
'重定义原来数组的大小，令其比原数组多1项，将新用户加在后面
numTemp=Ubound(arrayUsername)
Redim Preserve arrayUserName(numTemp+1)
arrayUserName(numTemp+1)=username
'下面保存到Application中
Application.Lock
Application(chatroom & "_arrayUserName")=arrayUserName
Application.Unlock
End If
End If
End Sub
'该子程序将用户从在线用户中删除
Sub DelUserName(username,chatroom)
'首先判断一下是否存在，如果存在则继续删除
If GetUserName(username,chatroom)=True Then
Dim arrayUsername,numTemp,I,J
arrayUsername=Application(chatroom & "_arrayUsername")
numTemp=Ubound(arrayUsername) '返回数组最大下标
'下面分两种情况删除
If numTemp>0 Then
'number>0表示有多个人，首先查找该用户，用变量J记住该用户所在位置
For I=0 To numTemp
If username=arrayUsername(I) Then '等于用户名
J=I '用J记住所在位置
End IF
Next
'所有人向前移动一个位置
For I=J To numTemp-1
arrayUsername(I)=arrayUsername(I+1)
Next
'重定义该数组的大小，令其比原数组少1
numTemp=Ubound(arrayUsername)
Redim Preserve arrayUserName(numTemp-1)
'下面将新的数组保存到Application中
Application.Lock
Application(chatroom & "_arrayUserName")=arrayUserName
Application.Unlock
Else
'numTemp>0不成立表示就只有他一个人，只要令Application中的值为空即可
Application.Lock
Application(chatroom & "_arrayUserName")=""
Application.Unlock
End If
End If
End Sub
'该函数返回该聊天室共有多少人
Function AllUserName(chatroom)
Dim arrayUsername,I
arrayUsername=Application(chatroom & "_arrayUsername")
If IsArray(arrayUsername)=True Then
'条件成立，表示这是数组，表示有人在线，所以返回第1维函数的下标加1
AllUserName=Ubound(arrayUsername,1)+1
Else
'否则，表示当前无人在线，为0
AllUserName=0
End If
End Function
'该函数用来将发言字符串中不属于自己的私聊删除
Function GetPrivate(strSays,username)
'num0是用来记录当前的位置，num1表示找到的第一个【，num2表示找到的第二个】,num3表示找到的第三个〗
Dim num0,num1,num2,num3,numLen
numLen=Len(strSays)
num0=1
'该循环表示从头到尾循环
Do While num0 '找寻三个标记在字符串中的位置
num1=InStr(num0,strSays,"【")
'如果num1=0，表示找不到,已经到最后了，直接返回原来字符串，退出函数即可
If num1=0 Then
GetPrivate=strSays
Exit Function
End If
num2=InStr(num1,strSays,"】")
num3=InStr(num2,strSays,"〗")
'下面判断一下是否是本人的，如果不是，将其删除，否则保留
If Mid(strSays,num1+1,num2-num1-1)="对" & username Then
'这表示是本人的,继续向下处理即可
num0=num3 '设置当前位置
Else
'这表示不是本人的，需要将其删除,注意要将之前的""也要删除
strSays=Left(strSays,num1-5) & Mid(strSays,num3+1)
numLen=numLen-(num3-num1+1)-4 '这是新的长度
num0=num1 '设置当前位置
End If
Loop
GetPrivate=strSays '返回处理后的字符串
End Function
%>
