function.asp

国内最早的在线客服系统源码.可以把访客变成自己的客户.是目前比较流行的在线客服系统

<%
'显示错误信息过程一
sub disp_error1(err_info,href)
	Response.Write("<div align=center><p><font color=#ff0000 size=+3>错误信息</font></p>")
	Response.Write(err_info)
	if href="" then
		Response.Write("<br>系统5秒后自动<a href='#' onclick='javascript:location.href=history.go(-1)'>返回</a>")
	else
		Response.Write("<a href="&href&">返回</a>")
	end if		
	Response.Write("<script language=javascript>")
	if href="" then
		Response.Write("setTimeout('location.href=history.go(-1)',5000);")
	end if
	Response.Write("</script>")
	Response.End 
end sub

'显示错误信息过程二
sub disp_error(err_info,href)
	Response.Write("<script language=javascript>")
	Response.Write("alert('"&err_info&"');")
	if href="" then
		Response.Write("location.href=history.go(-1);")
	else
		Response.Write("top.location.href='"&href&"';")
	end if
	Response.Write("</script>")
	Response.End 
end sub

sub disp_error2(info)
	Response.Write("<script language='javascript'>")
	Response.Write("alert('"&info&"');")
	Response.Write("window.close();")
	Response.Write("</script>")
end sub

'中止事务处理
function check_mts()
	if err.number<>0 then
		objcontext.setabort
	end if
end function

'检查用户注册信息
sub check_userinfo()
	dim err_info
	err_info=""
	yhm=trim(Request.Form("yhm"))
	if yhm="" then
		err_info=err_info&"●用户名不能为空！<br>"
	end if
	if len(yhm)>10 then
		err_info=err_info&"●用户名太长，请勿超过10个汉字！<br>"
	end if
	mm=trim(Request.Form("mm"))
	if mm="" then
		err_info=err_info&"●密码不能为空！<br>"
	end if
	if len(mm)>16 then
		err_info=err_info&"●密码太长，请勿超过16字符！<br>"
	end if
	if mm<>trim(Request.Form("mmqr")) then
		err_info=err_info&"●两次输入的密码不同！<br>"
	end if
	lc=trim(Request.Form("lc"))
	if lc="" then
		err_info=err_info&"●昵称不能为空！<br>"
	end if
	if len(xm)>6 then
		err_info=err_info&"●昵称太长，请勿超过6个汉字！<br>"
	end if
	mc1=trim(Request.Form("mc1"))
	if mc1="" then
		err_info=err_info&"●主页名称不能为空！<br>"
	end if
	grzy1=ucase(trim(Request.Form("grzy1")))
	if grzy1="" or grzy1="HTTP://" then
		err_info=err_info&"●网址不能为空！<br>"
	end if
	lx1=trim(Request.Form("grzy1"))
	if lx1="请选择" then
		err_info=err_info&"●主页类型不能为空！<br>"
	end if
	dzyj=trim(Request.Form("dzyj"))
	if dzyj="" then
		err_info=err_info&"●电子邮件不能为空！<br>"
	end if
	if len(dzyj)>25 then
		err_info=err_info&"●电子邮件太长，请勿超过25个字符！<br>"
	end if
	jj=trim(Request.Form("jj"))
	if jj="" then
		err_info=err_info&"●简介不能为空！<br>"
	end if
	if len(jj)>50 then
		err_info=err_info&"●简介太长，请勿超过50个汉字！<br>"
	end if
	if err_info<>"" then
		conn.close
		call disp_error1(err_info,"")
	end if
end sub

'新建在线站点队列
sub create_online_site()
	dim onlinesite()
	redim onlinesite(0)
	Application.Lock 
	application("onlinesite")=onlinesite
	Application.UnLock 
end sub

'新建当前站点在线用户队列
sub create_online_user(site_id)
	dim onlineuser()
	redim onlineuser(0)
	Application.Lock 
	application("onlineuser"&site_id)=onlineuser
	Application.UnLock 
end sub

'查找在线站点队列中是否已有该站点
'返回0--队列中没有该站点
'返回1--队列中有该站点
function find_online_site(site_id)
	dim i,dimsums,findok,sitestr
	findok=-1
	Application.Lock
	onlinesite=application("onlinesite")
	dimsums=ubound(onlinesite)
	for i=0 to dimsums
		siteinfo=onlinesite(i)
		sitestr=left(siteinfo,instr(siteinfo,"$"))
		if sitestr=cstr(site_id)&"$" then
			findok=i
			exit for
		end if
	next
	Application.UnLock
	find_online_site=findok
end function

'写入在线站点队列
function write_online_site(id,mc,lx,url,jj)
	dim siteinfo,dimsums,filename,fs,fpoint
	Application.Lock
	siteinfo=id&"$"&url&"$"&mc
	onlinesite=application("onlinesite")
	dimsums=ubound(onlinesite)
	redim preserve onlinesite(dimsums+1)
	onlinesite(dimsums+1)=siteinfo
	application("onlinesite")=onlinesite
	filename=server.mappath("/")&"\qq\siteinfo\"&id&".txt"
	set fs=createobject("scripting.filesystemobject")
	if not fs.fileexists(filename) then	
		set fpoint=fs.createtextfile(filename,true)
		fpoint.writeline("1")
		fpoint.writeline(mc)
		fpoint.writeline(lx)
		if left(url,7)<>"http://" then
			url="http://"&url
		end if
		fpoint.writeline(url)
		fpoint.writeline(jj)
		fpoint.close
	end if
	set fs=nothing
	Application.UnLock
	write_online_site=dimsums+1
end function

'查找当前用户是否在线
function find_online_user(site_id)
	dim i,dimsums,siteinfo,findok
	findok=0
	Application.Lock
	onlineuser=application("onlineuser"&site_id)
	dimsums=ubound(onlineuser)
	for i=0 to dimsums
		siteinfo=onlineuser(i)
		if siteinfo<>"" then
			if instr(siteinfo,session.SessionID)>0 then
				findok=1
				exit for
			end if
		end if
	next
	Application.UnLock
	find_online_user=findok
end function

'写入在线用户队列
sub write_online_user(site_id,faceid)
	dim userinfo
	Application.Lock
	if session("username")="" or session("siteid")="" then
		application("online")=application("online")+1
		userinfo=session.SessionID&"$"&"访客"&application("online")&"$"&"0$"&now()&"$"&now()&"$"&faceid
	else
		if session("manager")="1" then
			userinfo=session.SessionID&"$"&session("username")&"$"&"1$"&now()&"$"&now()&"$"&faceid
		else
			userinfo=session.SessionID&"$"&session("username")&"$"&"0$"&now()&"$"&now()&"$"&faceid
		end if
	end if
	onlineuser=application("onlineuser"&site_id)
	dimsums=ubound(onlineuser)
	redim preserve onlineuser(dimsums+1)
	onlineuser(dimsums+1)=userinfo
	application("onlineuser"&site_id)=onlineuser
	Application.UnLock
end sub

function find_online_manager(managerid)
	dim i,dimsums,findok
	findok=0
	Application.Lock
	onlinemanager=application("onlinemanager")
	dimsums=ubound(onlinemanager)
	for i=0 to dimsums
		siteinfo=onlinemanager(i)
		if siteinfo<>"" then
			if instr(siteinfo,managerid)>0 then
				findok=1
				exit for
			end if
		end if
	next
	Application.UnLock
	find_online_manager=findok
end function

'写入在线站长
sub write_online_manager(mc,url,lc,faceid)
	dim userinfo
	Application.Lock
	if left(url,7)<>"http://" then
		url="http://"&url
	end if
	userinfo=session.SessionID&"$"&session("siteid")&"$"&lc&"$"&mc&"$"&url&"$"&now()&"$"&now()&"$"&faceid
	onlinemanager=application("onlinemanager")
	dimsums=ubound(onlinemanager)
	redim preserve onlinemanager(dimsums+1)
	onlinemanager(dimsums+1)=userinfo
	application("onlinemanager")=onlinemanager
	onlineuser=application("onlineuser"&session("siteid"))
	dimsums=ubound(onlineuser)
	killflag=0
	for i=0 to dimsums
		if instr(onlineuser(i),cstr(session.sessionid))>0 then
			onlineuser(i)=replace(onlineuser(i),session("username")&"$0$",lc&"$1$")
			killflag=1
			exit for
		end if
	next
	if killflag=0 then
		call write_online_user(session("siteid"),faceid)
	end if
	application("onlineuser"&session("siteid"))=onlineuser
	Application.UnLock
end sub

function getsitename(site_id)
	dim infostr,filename,fs,fpoint
	on error resume next
	infostr=""
	filename=server.mappath("/")&"\qq\siteinfo\"&site_id&".txt"
	set fs=createobject("scripting.filesystemobject")
	if fs.fileexists(filename) then	
		set fpoint=fs.opentextfile(filename,1,true)
		fpoint.skipline
		infostr=fpoint.readline
		fpoint.close
	end if
	set fs=nothing
	Application.UnLock
	getsitename=infostr
end function

'删除过期用户
sub lost_user(flag)
	dim delflag,dimsums,onlinesums,num
	Application.Lock
	if flag=1 then
		onlineuser=application("onlineuser"&session("siteid"))
	else
		onlineuser=application("onlinemanager")
	end if
	dimsums=ubound(onlineuser)
	onlinesums=dimsums
	num=0
	for i=0 to dimsums
		delflag=0
		if onlineuser(i)="" then
			delflag=1
		else
			sj=left(onlineuser(i),instrrev(onlineuser(i),"$")-1)
			sj=cdate(right(sj,len(sj)-instrrev(sj,"$")))
			if datediff("s",sj,now())>420 then
				delflag=1
			end if
		end if
		if delflag=0 then
			if num<i then
				onlineuser(num)=onlineuser(i)
			end if
			num=num+1
		else
			if num<i then
				onlineuser(num)=onlineuser(i)
			end if
			onlinesums=onlinesums-1
		end if
	next
	redim preserve onlineuser(onlinesums)
	if flag=1 then
		application("onlineuser"&session("siteid"))=onlineuser
	else
		application("onlinemanager")=onlineuser
	end if
	Application.UnLock
end sub

'得到7个汉字长度或14个字母长度的字符串
Function GetNewStr(InputStr)
	dim i,number,newstr,substr
	number=0
	newstr=""
	for i=1 to len(InputStr)
		substr=mid(InputStr,i,1)
		if asc(substr)<0 then
			number=number+2
		else
			number=number+1
		end if
		if number<=9 then
			newstr=newstr&substr
		else
			newstr=newstr&"..."
			exit for
		end if
	next
	GetNewStr=newstr
End Function
'过滤网站名称
Function YesSite(SiteName)
	Dim NoName(6),i,Yes
	NoName(0)="成人"
	NoName(1)="AV"
	NoName(2)="性"
	NoName(3)="同志"
	NoName(4)="美女"
	NoName(5)="美眉"
	NoName(6)="春宵"
	Yes=0
	If SiteName<>"" then
		For i=0 To 6
			If Instr(SiteName,NoName(i))>0 then
				Yes=1
				Exit For
			End If
		Next
	Else
		Yes=1
	End If
	YesSite=Yes
End Function
%>