useradmin.asp

直接在页面上使用标签加入友情链接站点,非使用跳转页面 ,可设置是否要求PR值验证,及所要求PR值大小,可设置是否要求Alexa排名验证,及所要求的Alexa排名次序
ASP
第 1 页 / 共 2 页
字号:
12 下一页
<!--#include file="conn.asp"-->
<!--#include file="common.asp"-->
<!--#include file="md5.asp"-->

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<LINK href="css.css" type=text/css rel=stylesheet>
<%
if session("L_username")="" or session("L_userid")="" then
	Errmsg = Errmsg+"<li>您没有登录。"
	Call ErrList(Errmsg)
	response.end
end if
%>
<%
dim SiteName
dim SiteURL
dim MasterName
dim Email

dim PR
dim Alexa
dim IsConfirm
dim IsVerify
dim SpecialNote
dim WordsCount
dim AltCount
dim LogoWidth
dim LogoHeight
dim OrderBy
dim MaxPerPage
dim PageWidth
dim Unit
dim alternation

dim L_SiteName
dim L_SiteURL
dim L_Logo
dim L_Alt

sql="select * from setting"
set rs=conn.execute (sql)
if not rs.eof then
	SiteName=rs("SiteName")
	SiteURL=rs("SiteURL")
	MasterName=rs("MasterName")
	Email=rs("Email")
	
	PR=rs("PR")
	Alexa=rs("Alexa")
	IsConfirm=rs("IsConfirm")
	IsVerify=rs("IsVerify")
	SpecialNote=rs("SpecialNote")
	WordsCount=rs("WordsCount")
	AltCount=rs("AltCount")
	LogoWidth=rs("LogoWidth")
	LogoHeight=rs("LogoHeight")
	OrderBy=rs("OrderBy")
	MaxPerPage=rs("MaxPerPage")
	PageWidth=rs("PageWidth")
	Unit=rs("Unit")
	alternation=rs("alternation")
	
	L_SiteName=rs("L_SiteName")
	L_SiteURL=rs("L_SiteURL")
	L_Logo=rs("L_Logo")
	L_Alt=rs("L_Alt")

	rs.close
end if

dim Y_email
dim Y_SiteName
dim Y_SiteURL
dim Y_Logo
dim Y_Alt
dim Y_MyLink

dim jointime
dim goin
dim goout

sql="select email,Y_SiteName,Y_SiteURL,Y_Logo,Y_Alt,Y_MyLink,jointime,goin,goout from link where ID="&session("L_userid")
set rs=conn.execute (sql)
if not rs.eof then
	Y_email=rs("email")
	Y_SiteName=rs("Y_SiteName")
	Y_SiteURL=rs("Y_SiteURL")
	Y_Logo=rs("Y_Logo")
	Y_Alt=rs("Y_Alt")
	Y_MyLink=rs("Y_MyLink")
	
	jointime=rs("jointime")
	goin=rs("goin")
	goout=rs("goout")
	rs.close
end if

wordlink="<a href=""http://"&request.ServerVariables("HTTP_HOST")&replace(request.ServerVariables("URL"),"signup.asp","linkforward.asp")&"?friendid="&session("L_userid")&"&goto="&L_SiteURL&""" target=_blank title="""&L_Alt&""">"&L_SiteName&"</a>"
logolink="<a href=""http://"&request.ServerVariables("HTTP_HOST")&replace(request.ServerVariables("URL"),"signup.asp","linkforward.asp")&"?friendid="&session("L_userid")&"&goto="&L_SiteURL&""" target=_blank><img border=0 src="""&L_Logo&""" alt="""&L_Alt&"""></a>"

%>

<%
if request("operate")=1 then
	Call submit1()
end if
if request("operate")=2 then
	Call submit2()
end if

sub submit2
	sql="delete * from link where ID="&session("L_userid")
	conn.execute(sql)
	response.write("<script>alert('操作成功!');document.URL='logout.asp';</script>")
end sub


sub submit1
	Y_email=trim(replace(request("Y_email"),"'",""))
	Y_SiteName=trim(replace(request("Y_SiteName"),"'",""))
	Y_SiteURL=trim(replace(request("Y_SiteURL"),"'",""))
	passsword=trim(replace(request("passsword"),"'",""))
	repasssword=trim(replace(request("repasssword"),"'",""))
	Y_Logo=trim(replace(request("Y_Logo"),"'",""))
	Y_Alt=trim(replace(request("Y_Alt"),"'",""))
	Y_MyLink=trim(replace(request("Y_MyLink"),"'",""))
	
	if Y_email="" or Y_SiteName="" or Y_SiteURL="" or Y_Logo="" or Y_Alt="" or Y_MyLink="" then
		response.write "<script>alert(""请填写全部信息!"");window.history.back();</script>"
		response.end		
	end if
	
	if IsValidEmail(Y_email)=false then
		response.write "<script>alert(""请填写正确的电子邮箱地址!"");window.history.back();</script>"
		response.end		
	end if
	
	if passsword<>"" then
		if passsword<>repasssword then
			response.write "<script>alert(""两次输入密码不一致!"");window.history.back();</script>"
			response.end		
		end if
		sql="update link set email='"&Y_email&"', Y_SiteName='"&Y_SiteName&"', Y_SiteURL='"&Y_SiteURL&"', Y_Logo='"&Y_Logo&"', Y_Alt='"&Y_Alt&"', Y_MyLink='"&Y_MyLink&"', passsword='"&md5(passsword)&"'"
	else
		sql="update link set email='"&Y_email&"', Y_SiteName='"&Y_SiteName&"', Y_SiteURL='"&Y_SiteURL&"', Y_Logo='"&Y_Logo&"', Y_Alt='"&Y_Alt&"', Y_MyLink='"&Y_MyLink&"'"
	end if
	
	if GetWordsCount(Y_SiteName)>WordsCount then
		Errmsg = Errmsg+"<li>您的站点的名称字数<"&GetWordsCount(Y_SiteName)&">大于系统规定字数<"&WordsCount&">。"
		Call ErrList(Errmsg)
		response.end
		exit sub		
	end if
	
	if GetWordsCount(Y_Alt)>AltCount then
		Errmsg = Errmsg+"<li>您的站点的介绍字数<"&GetWordsCount(Y_Alt)&">大于系统规定字数<"&AltCount&">。"
		Call ErrList(Errmsg)
		exit sub		
		response.end
	end if
	
	'第一步,判断我站链接所在位置和申请的链接是否为同一域
	if left(Y_SiteURL,7)<>"http://" then
		Errmsg = Errmsg+"<li>请注意您的URL格式,应以http://开头。"
		Call ErrList(Errmsg)
		exit sub		
	end if
	Y_SiteURL_Arr=Split(Y_SiteURL,"/")
	Y_MyLink_Arr=Split(Y_MyLink,"/")
	if Y_SiteURL_Arr(2)<>Y_MyLink_Arr(2) then
		Errmsg = Errmsg+"<li>申请友情链接的域和我站链接代码不在同一个域内。"
		Call ErrList(Errmsg)
		exit sub		
		response.end
	end if
	
	'第二步,判断是否已经添加了我站链接代码
	if IsConfirm=true then
		url=Y_MyLink
		wstr=getHTTPPage(url) 

		if not Instr(lcase(wstr),lcase("<a href=""http://"&request.ServerVariables("HTTP_HOST")&replace(request.ServerVariables("URL"),"useradmin.asp","linkforward.asp")))>0 then
			Errmsg = Errmsg+"<li>对不起,没有在贵站的指定的位置上发现我站的链接代码。<li>请首先在贵站添加我站的链接代码,谢谢。"
			Call ErrList(Errmsg)
			exit sub		
		response.end
		end if
	end if
		
	'第三步,判断我站链接所在网页页面的PR值
	
	Dim wstr,str,url,start,over,id
	ID = Y_MyLink
	url="http://rankwhere.com/google-page-rank.php?url="&id&""
	wstr=getHTTPPage(url) 
	start=Newstring(wstr,"has Google")
	over=Newstring(wstr,"NOTE")
	body=mid(wstr,start+0,over-start-10)
	
	body_arr=Split(body," ")
	Y_MyLink_PR=int(body_arr(3))
	if PR>0 then
		if not Y_MyLink_PR>= PR then
			Errmsg = Errmsg+"<li>对不起,我站的链接代码所在页面PR值<"&Y_MyLink_PR&">不符合我站的要求<"&PR&">。"
			Call ErrList(Errmsg)
			exit sub		
			response.end
		end if
	end if
	
	'第四步,判断我站链接所在网页的所属域名的Alexa排名
	ID = Y_MyLink
	url="http://www.alexa.com/data/details/traffic_details?q=&url="&id&""
	wstr=getHTTPPage(url) 
	start=Newstring(wstr,"span msg=")
	over=start+60
	if len(wstr)=start then
		Y_MyLink_Alexa="未收录"
	else
		body=mid(wstr,start+0,over-start-10)
		body_arr=Split(body,"""")
		Y_MyLink_Alexa_Code=body_arr(1)
		url="http://"&request.ServerVariables("HTTP_HOST")&replace(request.ServerVariables("URL"),"useradmin.asp","getAlexa.asp")
		
		url=url&"?sMsg="&Y_MyLink_Alexa_Code
		wstr=getHTTPPage(url)
		start=Newstring(wstr,"<begin>")
		over=Newstring(wstr,"<end>")
		body=mid(wstr,start+7,over-start-7)
		
		dim temp_Alexa
		temp_Alexa=""
		if InStr(body,",")>0 then
			body_arr=Split(body,",")
			for i=0 to UBound(body_arr)
				temp_Alexa=temp_Alexa&body_arr(i)
			next
		else
			temp_Alexa=body
		end if
		Y_MyLink_Alexa=Clng(temp_Alexa)
	end if
	if Alexa>0 then
		if Alexa<Y_MyLink_Alexa or Y_MyLink_Alexa="未收录" then
			Errmsg = Errmsg+"<li>对不起,贵站的Alexa世界排名值<"&temp_Alexa&">不符合我站的要求<"&Alexa&">。"
			Call ErrList(Errmsg)
			exit sub		
			response.end
		end if
	end if
	sql=sql& ",PR="&Y_MyLink_PR&",PRDate='"&now()&"',Alexa='"&Y_MyLink_Alexa&"',AlexaDate='"&now()&"' where ID="&session("L_userid")
	conn.execute (sql)
	response.write "<script>alert(""操作成功!"");document.URL=""useradmin.asp#1"";</script>"
end sub
%>
<title><%response.write SiteName&"-自助友情链接系统 - Power By TODO.NET.CN"%></title>
<script>
function CloseOpen(Num){
	var CurrObj=eval("Tab"+Num);
	if (CurrObj.style.display!="none"){
		CurrObj.style.display="none";
		window.event.srcElement.src="img/collapsed_yes.gif"
	} else {
		CurrObj.style.display="";
		window.event.srcElement.src="img/collapsed_no.gif"
	}
12 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -