r.asp

基于ASP开发的聊天室源码

<%
Response.Expires = 0
Response.ExpiresAbsolute = Now()-1
Response.AddHeader "Pragma","No-Cache"
Response.AddHeader "Cache-Control","Private"
Response.CacheControl = "No-Cache"
Dim sj,mygrade,words,hename,fs,namecolor,saycolor,bq,tx,henamelink,selflink,line,newline,nowline,lenwords,i,j,s
If Not IsArray(Session("info")) Then
	Response.Write "<script language='javascript'>top.location.href='err.asp?kind=20';</script>"
	Response.End
End If
info = Session("info")
If InStr(Application("maninfo"),"," & info(0) & ",") <> 0 Then Response.Redirect "manyou.asp"
mygrade = "," & info(1) & ","
If DateDiff("s",info(9),now) < 3 Then
	info(9) = now
	Session("info") = info
	Response.Write "<script language='javascript'>alert('你说话这么急干什么？');</script>"
	Response.End
End If
If InStr(Application("zzbird_man_say"),mygrade) = 0 Then Response.End
sj = CStr(time)
words = Trim(Request.QueryString("words"))
hename = Trim(Request.QueryString("hename"))
fs = Trim(Request.QueryString("fs"))
namecolor = "#" & Server.URLEncode(Trim(Request.QueryString("namecolor")))
saycolor = "#" & Server.URLEncode(Trim(Request.QueryString("saycolor")))
bq = server.HTMLEncode(Trim(Request.QueryString("bq")))
tx = Trim(Request.QueryString("tx"))
If InStr(Application("zzbird_man_html"),mygrade) = 0 Then words = server.HTMLEncode(words)
words = Replace(words,"([{zzbird{(]","+")
hename = Replace(hename,",","")
If words = "" Then
	info(9) = now
	Session("info") = info
	Response.Write "<script language='javascript'>alert('请输入发言的内容！');</script>"
	Response.End
End If
If hename = "" Then hename="大家"
If hename = info(0) Then
	info(9) = now
	Session("info") = info
	Response.Write "<script language='javascript'>alert('自言自语？');</"&"script>"
	Response.End
End If
If fs <> "allsay" and fs <> "onlysay" and fs <> "titlesay" Then fs = "allsay"
If fs = "onlysay" and hename = "大家" Then fs = "allsay"
If fs = "titlesay" and InStr(Application("zzbird_man_title"),mygrade) = 0 Then fs = "allsay"
If (fs = "allsay" or fs = "onlysay") and InStr(Application("zzbird_name_" & info(7)),"," & hename & ",") = 0 and hename <> "大家" Then
	info(9) = now
	Session("info") = info
	Response.Write "<script language='javascript'>alert('对不起，该聊友不在该聊天室内，无法对其发言。');</"&"script>"
	Response.End
End If
If InStr(Application("zzbird_man_texiao"),mygrade) = 0 Then tx = ""
henamelink = "<a href=javascript:parent.l3.selectuser('[" & hename & "]'); target=l3><font color=0000ff>" & hename & "</font></a>"
selflink = "<a href=javascript:parent.l3.selectuser('[" & info(0) & "]'); target=l3><font color='" & namecolor & "'>" & info(0) & "</font></a>"
If Len(namecolor) <> 7 Then namecolor = "#000000"
If Len(saycolor) <> 7 Then saycolor = "#000000"
If Len(bq) > 10 Then bq = Left(bq,10)
If Len(words) > 60 Then words = Left(words,60)
If fs = "titlesay" Then
	words = selflink & "：<font color=" & saycolor & ">" & words & "</font>"
Else
	If InStr(words,"//") = 1 Then
		words = Replace(words,"//","",1,1)
		words = selflink & "<font color=" & saycolor & ">" & words & "</font>"
	Else
		words = selflink & bq & "对" & henamelink & "说：<font color=" & saycolor & ">" & words & "</font>"
	End If
	If fs = "onlysay" Then words="[密谈]" & words
	words = Replace(words,"(self)",selflink)
	words = Replace(words,"(name)",henamelink)
End If
If InStr(Application("zzbird_man_pic"),mygrade) <> 0 Then
	Do While InStr(words,"[img]")<>0 and InStr(words,"[/img]")<>0
		words = Replace(words,"[img]","<img src='pic/",1,1)
		words = Replace(words,"[/img]","'>",1,1)
	Loop
End If
words = Replace(words,"\","\\")
words = Replace(words,chr(34),"\"&chr(34))
words = Replace(words,"/","\/")
If fs = "titlesay" Then
	words = words & "<font style='font-size: 8pt' color='#808080'>(" & sj & ")</font>"
Else
	words = "<img src='images/ico/" & info(4) & "-2.gif' height='16' width='16'>" & words & "<font style='font-size: 8pt' color='#808080'>(" & sj & ")</font>"
End If
Select Case tx
	Case "jc" words = "<b>" & words & "</b>"
	Case "qx" words = "<i>" & words & "</i>"
	Case "cx" words = "<b><i>" & words & "</i></b>"
	Case "xx" words = "<u>" & words & "</u>"
	Case "sx" words = "<span style='text-decoration: overline'>" & words & "</span>"
	Case "zx" words = "<span style='text-decoration: line-through'>" & words & "</span>"
	Case "zg" words = "<marquee scrollamount=1 scrolldelay=12 direction=right truespeed>" & words & "</marquee>"
	Case "yg" words = "<marquee scrollamount=1 scrolldelay=12 truespeed>" & words & "</marquee>"
End Select
Dim newsay(240)
Dim show()
Redim Preserve show(0)
j = 1
s = 1
newline = 0
nowline = info(8)
Application.Lock
	oldsay = Application("zzbird_words")
	line = Application("zzbird_line")
	Application("zzbird_line") = line + 1
	For i = 7 To 240 Step 6
		newsay(j) = oldsay(i)
		newsay(j + 1) = oldsay(i + 1)
		newsay(j + 2) = oldsay(i + 2)
		newsay(j + 3) = oldsay(i + 3)
		newsay(j + 4) = oldsay(i + 4)
		newsay(j + 5) = oldsay(i + 5)
		newline = newsay(j)
		If newline > nowline And newline > 0 And Not (newsay(j + 3) = "onlysay" And newsay(j + 2) <> info(0) And newsay(j + 1) <> info(0) Or newsay(j + 3) = "callyou" And InStr(newsay(j + 2),info(0)&"|") <> 1) Then
			Redim Preserve show(s + 4)
			show(s) = newsay(j + 1)
			show(s + 1) = newsay(j + 2)
			show(s + 2) = newsay(j + 3)
			show(s + 3) = newsay(j + 4)
			show(s + 4) = newsay(j + 5)
			s = s + 5
		End If
		j = j + 6
	Next
	newsay(235) = line + 1
	newsay(236) = info(0)
	newsay(237) = hename
	newsay(238) = fs
	newsay(239) = words
	newsay(240) = info(6)
	Application("zzbird_words") = newsay
Application.UnLock
Redim Preserve show(s + 4)
show(s) = info(0)
show(s + 1) = hename
show(s + 2) = fs
show(s + 3) = words
show(s + 4) = info(6)
newline = line + 1
Response.Write "<script Language=JavaScript>var myroom = '" & info(6) & "';"
Response.Write "if(window==window.top){top.location.href='chat.asp?fp=1';}if(parent.nowroom!=myroom){parent.nowroom=myroom;}"
For i = 1 to UBound(show) step 5
	Response.Write "parent.w(" & chr(34) & show(i) & chr(34) & "," & chr(34) & show(i+1) & chr(34) & "," & chr(34) & show(i+2) & chr(34) & "," & chr(34) & show(i+3) & chr(34) & "," & chr(34) & show(i+4) & chr(34) & ");" & chr(13) & chr(10)
Next
If InStr(Application("giveyou"),"," & info(0) & ";") <> 0 Then Response.Write "parent.giveyou.location.href='giveyou.asp';"
Response.Write "parent.timev='" & time & "';</script>"
If newline > nowline Then info(8) = newline
info(9) = now
Session("info") = info
%>