txlfun.asp

同学录的设计

end function



function delonline(username)
	dim	tempusername
	conn.execute ("update online set sname=null where sname='"&username&"' and ip='"&Session("user_ip")&"'")
end function


function getuserip
	dim tempuserip
	Randomize
	tempuserip=Request.ServerVariables("Remote_host")
	tempuserip=tempuserip&":"&Fix(Rnd*10000)
	getuserip=tempuserip
end function


Rem 判断外部提交
function outsitesubmit
	dim server_v1,server_v2
	server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
    server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
	if mid(server_v1,8,len(server_v2))<>server_v2 then
		 outsitesubmit=true  
	end if
end function

Rem	短信发布函数
function sendpermsg(username,towho,title,content,adddate)
	on error resume next
	dim sql
	sql="insert into permsg (username,towho,title,content,adddate) values('"
	sql=sql&username&"','"&towho&"','"&title&"','"&content&"','"&now()&"')"
	conn.execute sql
	if err then
		sendpermsg=false
	else
		sendpermsg=true
	end if
end function

Rem 得到系统短信
Function getmsgnum(userid)
	Dim rs,Int_num
	set rs=Conn.execute("Select Count(*) from permsg where towho='"&userid&"' and isread=0")
	Int_num=rs(0)
	getmsgnum=Int_num
	rs.close
	set rs=nothing
End Function

sub showonlineinfo
	dim rs,onlinetotalcount,onlineusercount,onlineuserstr
	onlinetotalcount=0
	onlineusercount=0
	onlineuserstr=""
	set rs=conn.execute("select ec.studentid,ec.sname,online.ip,online.entertime,online.newtime from online left join  ec on ec.studentid=online.sname")
	while not rs.eof
		IF not isnull(rs("studentid")) Then
			onlineusercount=onlineusercount+1
			onlineuserstr=onlineuserstr&"<font style='cursor:hand' title='"&rs(0)&" 进入时间:"&gethms(rs("entertime"))&" 最新活动时间:"&gethms(rs("newtime"))&"'>"&rs(1)&"</font> "
		End IF
		onlinetotalcount=onlinetotalcount+1
		rs.movenext
	wend
	rs.close
	set rs=nothing
	Response.Write "■ 总在线：<b>"&onlinetotalcount&"</b>人<br>"&Vbcrlf
	Response.Write "■ 登录会员:<b>"&onlineusercount&"</b>人 游客：<b>"&onlinetotalcount-onlineusercount&"</b>人<br>"&Vbcrlf
	Response.Write "■ 在线会员："&onlineuserstr
	Response.Flush
end sub

Function winsteps()
	dim winstepsstr
	winstepsstr=""
	winstepsstr=winstepsstr&"<table width=""99%"" border=""0"" cellspacing=""2"" cellpadding=""2"">"&Vbcrlf
	winstepsstr=winstepsstr&"	<tr>"&Vbcrlf
	winstepsstr=winstepsstr&"		<td align=""center""></td>"&Vbcrlf
	winstepsstr=winstepsstr&"	</tr>"&Vbcrlf
	winstepsstr=winstepsstr&"	<tr>"&Vbcrlf
	winstepsstr=winstepsstr&"		<td align=""center""></td>"&Vbcrlf
	winstepsstr=winstepsstr&"	</tr>"&Vbcrlf
	winstepsstr=winstepsstr&"</table>"&Vbcrlf
	Response.Write winstepsstr
	Response.Flush
End Function
function gethms(datastr)
	dim h,m,s
	h=hour(datastr)
	m=minute(datastr)
	s=second(datastr)
	if h<10 then h="0"&h
	if m<10 then m="0"&m
	if s<10 then s="0"&s
	gethms=h&":"&m&":"&s
end function

Rem 留言脏字过滤
function BadWords_Deal(tempStr)

	Dim Str
	Str = tempStr
    Dim BadWordString_Temp,i,Temp_N
    BadWordString_Temp = split(const_BadWordString, "|")
    Temp_N = ubound(BadWordString_Temp)
    for i = 0 to Temp_N
        Str = Replace(Str, BadWordString_Temp(i), string(len(BadWordString_Temp(i)),"*"), 1,-1,0) 
    next
    BadWords_Deal = Str
end function

Rem 得到username的真实姓名
function getmasterusername(username)
	dim rs
	getmasterusername=""
	set rs=conn.execute ("select sname from ec where studentid='"&username&"'")
	if  rs.eof then
		getmasterusername=""
	else
		getmasterusername=rs(0)
	end if
	rs.close
	set rs=nothing
end function

Rem  多功能分页函数
Rem  参数说明，(页面数，记录数，当前页，页大小，连接，跨越度)
Function ShowPage(ByRef PageCount,RecordCount,CurrentPage,PageSize,LinkFile,displaypagenum)

	Dim Retval,J,StartPage,EndPage
	If (RecordCount Mod PageSize)=0 Then
	    PageCount=RecordCount \ PageSize
	Else 
	    PageCount=RecordCount \ PageSize+1
	End If
	If PageCount=0 Then PageCount=1
	If CurrentPage="" Then CurrentPage=1 else CurrentPage=CInt(CurrentPage)
	Retval=Retval & "<table width='100%' border='0' cellspacing='0' cellpadding='0'>"
    Retval=Retval & "<tr>"
    Retval=Retval & "<td height='20'>"
	If CurrentPage=1 Then              
		Retval=Retval & "<font style='color:#999999'>首页</font> | <font style='color:#999999'>前页</font> | " 
	Else
		Retval=Retval & "<a href='" & LinkFile & "Page=1' style='color:#000000'>首页</a> | <a href='" & LinkFile & "Page=" & CurrentPage - 1 & "' style='color:#000000'>前页</a> | "
	End If
	If  CurrentPage=PageCount Then             
		Retval=Retval & "<font style='color:#999999' style='color:#000000'>后页</font> | <font style='color:#999999'>末页</font>"
	Else
		Retval=Retval & "<a href='" & LinkFile & "Page=" & CurrentPage + 1 & "' style='color:#000000'>后页</a> | <a href='" & LinkFile & "Page=" & PageCount & "' style='color:#000000'>末页</a>"
	End if
	If RecordCount>0 Then
	    Retval=Retval & " | <b>"&CurrentPage&"</b>页/<b>"&CInt(PageCount)&"</b>页 | 共<b>"&RecordCount&"</b>条记录"
	End If
	Retval=Retval & "<td align='right'>"
	StartPage = Page-displaypagenum
	EndPage = Page+displaypagenum
	If StartPage<=0 Then
	    StartPage=1
	ElseIf StartPage>1 Then 
	    Retval=Retval & " <a href='" & LinkFile & "Page=1' style='font-family:webdings' title='首页'>9</a>"
	    Retval=Retval & " ... "
	End If	    
	If EndPage>PageCount Then EndPage=PageCount
	For J = StartPage to EndPage
		If J = Page Then
		    Retval = Retval & " <font color=#999999>" & J & "</font>"
		Else
		    Retval = Retval & " <a href='" & LinkFile & "Page=" & J & "' style='color:#000000'>" & J & "</a>"
		End If
	Next
	If EndPage < PageCount Then Retval= Retval & " ... <a href='" & LinkFile & "Page=" & PageCount & "' style='font-family:webdings;color:#000000'' title='末页'>:</a>"
	Retval=Retval & "</td>"
	Retval=Retval & "</tr>"
    Retval=Retval & "</table>"
	ShowPage=Retval
End Function

Function showuserpic(picurl,picwidth,picheight)
	dim width_xx,height_xx
	If 	picwidth>120 Then 
		width_xx="width=120"
	Elseif picwidth>0 then
		width_xx="width="&picwidth
	ElseIf picwidth=0 Then
		width_xx=""
	End If

	If picheight>Int(Split(const_Faceheight,"|")(1)) Then
		height_xx="height="&Split(const_FaceWidth,"|")(1)
	ElseIf picheight>0  Then
		height_xx="height="&picheight
	ElseIf picheight=0 Then
		height_xx=""
	End If
	IF lcase(Left(picurl,5))="http:" then
		Response.Write "<img name='faceimg' border=0 src='" + picurl + "'"  & width_xx & " " & height_xx  & " onload=""javascript:if(this.width>120)   this.width=120"">"
	ElseIf picurl<>"" and (not isnull(picurl)) Then
		Response.Write("<img name='faceimg'  border=0 src='"&const_txl_HomeUrl&picurl + "' " & width_xx & " " & height_xx & " onload=""javascript:if(this.width>120)   this.width=120"">")
	End If
End Function


'**************************************************
'函数名：gotTopic
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'       strlen ----截取长度
'返回值：截取后的字符串
'***************************************************
function walkgotTopic(str,strlen)
	if str="" then
		walkgotTopic=""
		exit function
	end if
	dim l,t,c, i
	str=replace(replace(replace(replace(str,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
	l=len(str)
	t=0
	for i=1 to l
		c=Abs(Asc(Mid(str,i,1)))
		if c>255 then
			t=t+2
		else
			t=t+1
		end if
		if t>=strlen then
			walkgotTopic=left(str,i) & "…"
			exit for
		else
			walkgotTopic=str
		end if
	next
	walkgotTopic=replace(replace(replace(replace(walkgotTopic," ","&nbsp;"),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
end function
%>