function.asp

与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")
	If IsArray(arrayUserName) Then
		For I=0 To Ubound(arrayUsername)
			If username=arrayUsername(I,1) Then      '等于用户名
			   GetUserName=True
			   Exit Function
			End IF
		Next
	End If
	GetUserName=False
End Function

'该函数用来给在线人数赋初值
Sub NewUserName(chatroom)
	Dim arrayTemp
	arrayTemp=Application(chatroom & "_arrayUserName")
	If IsArray(arrayTemp)=False Then
		Dim arrayUserName(0,1)
		Application.Lock
		Application(chatroom & "_arrayUserName")=arrayUserName
		Application.Unlock
	End If
End Sub

'该函数用来将该用户加入列表
Sub AddUserName(username,chatroom)
	'首先判断一下是否存在，如果不存在则继续添加
	If GetUserName(username,chatroom)=False Then
		Dim arrayUsername,numTemp,I
		arrayUsername=Application(chatroom & "_arrayUsername")
		numTemp=Ubound(arrayUsername)
		'定义一个新的数组
		Dim arrayTemp()
		Redim arrayTemp(numTemp+1,1)
		For I=0 To numTemp
			arrayTemp(I,0)=arrayUsername(I,0)
			arrayTemp(I,1)=arrayUsername(I,1)
		Next
		arrayTemp(numTemp+1,0)=Session("IP")    '保存IP地址
		arrayTemp(numTemp+1,1)=username         '保存用户名
		'下面加进去
		Application.Lock
		Application(chatroom & "_arrayUserName")=arrayTemp
		Application.Unlock
	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)
		For I=0 To numTemp
			If username=arrayUsername(I,1) Then      '等于用户名
				J=I                                  '用J记住所在位置
			End IF
		Next
		If numTemp>0 Then
			'将其后的所有人往前挪一个位置
			For I=J To numTemp-1
				arrayUsername(I,0)=arrayUsername(I+1,0)
				arrayUsername(I,1)=arrayUsername(I+1,1)
			Next
			'定义一个新的数组
			Dim arrayTemp()
			Redim arrayTemp(numTemp-1,1)
			For I=0 To numTemp-1
				arrayTemp(I,0)=arrayUsername(I,0)
				arrayTemp(I,1)=arrayUsername(I,1)
			Next
			'下面加进去
			Application.Lock
			Application(chatroom & "_arrayUserName")=arrayTemp
			Application.Unlock
		Else
			'表示就一个人，调用子程序将其初始化即可
			Call NewUserName(chatroom)
		End If
	End If
End Sub

'该函数返回该聊天室共有多少人
Function AllUserName(chatroom)
	Dim arrayUsername,I
	arrayUsername=Application(chatroom & "_arrayUsername")
	If IsArray(arrayUsername)=False Then
		AllUserName=0
	Else
		AllUserName=Ubound(arrayUsername)
	End If
End Function


'该函数在适当的位置插入一个书签，这样保证始终能看到最下边发表的内容
Function GetBookMark(strSays)
	If strSays="" Then
		GetBookMark=""
		Exit Function
	End If
	'下面先从后面开始查找第20个换行符，如果找到numBr>0,否则返回0
	Dim I,numBr
	numBr=Len(strSays)
	For I=1 To 20
		numBr=InStrRev(strSays,"<br>",numBr)
		If numBr=0 Then
			Exit For
		End If
	Next
	
	'如果numBr>0，表示确实从后面找到了第20个换行符号，则在中间加一个书签
	If numBr>0 Then
		strSays=Left(strSays,numBr-1) &  "<a name='bookmark'></a>" & Mid(strSays,numBr)
	End If
	GetBookMark=strSays
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
			'这表示是本人的，需要将最后的〗删除
			strSays=Left(strSays,num3-1) & Mid(strSays,num3+1)
			numLen=numLen-1
			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
%>