function.asp

这是聊天室的源代码 很好实现的 看看吧

<%
'*****************************************************
' 这是函数文件，保存其它页面用到的函数
'*****************************************************

'该函数返回姓名颜色
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<numLen
			'找寻三个标记在字符串中的位置
			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
				'这表示不是本人的，需要将其删除,注意要将之前的"<br>"也要删除
				strSays=Left(strSays,num1-5) & Mid(strSays,num3+1)
				numLen=numLen-(num3-num1+1)-4      '这是新的长度
				num0=num1                          '设置当前位置
			End If
		Loop
		GetPrivate=strSays                         '返回处理后的字符串
	End Function
%>