<%
'顯示錯誤信息過程一
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
%>