<%
if request("action")="addlink" then
call addlink
else
call showaddform
end if
sub showaddform
%>
申请流程：填写资料 -> 获取代码 -> 放到自己的主页上 -> 点击一次到我站 -> OK
<%end sub%>
<%sub addlink
dim username,sitename,siteurl,sitelogo,email,password,pwdconfirm,webtype,siteintro
username=hx.checkstr(request.form("username"),12)
sitename=hx.checkstr(request.form("sitename"),12)
siteurl=hx.checkstr(request.form("siteurl"),100)
sitelogo=hx.checkstr(request.form("sitelogo"),100)
email=hx.checkstr(request.form("email"),50)
password=hx.checkstr(request.form("password"),12)
pwdconfirm=hx.checkstr(request.form("pwdconfirm"),12)
webtype=request.form("webtype")
siteintro=hx.checkstr(request.form("siteintro"),250)
dim blnerror,strerror
blnerror=false
if username="" or sitename="" or siteurl="" or password="" or siteintro="" or email="" then
blnerror=true
strerror="
请检查是否有必填信息没有填写！"
end if
if blnerror=false then
if hx.blnfilter(sitename,1) then
blnerror = true
strerror = strerror & "
网站名称不能包含某些特殊关键词！"
end if
if hx.blnfilter(siteintro,1) then
blnerror = true
strerror = strerror & "
网站简介不能包含某些特殊关键词！"
end if
if hx.blnfilter(siteurl,2) then
blnerror = true
strerror = strerror & "
此域名已经被屏蔽！"
end if
if sitelogo="" then
sitelogo="http://" & hx.BaseUrl & "images/wu.gif"
end if
if left(sitelogo,7)<>"http://" then sitelogo="http://" & sitelogo
if left(siteurl,7)<>"http://" then siteurl="http://" & siteurl
'增强邮箱和网址的判断
if not CheckEmail(email) then
blnerror = true
strerror = strerror & "
联系邮箱不正确！"
end if
if not CheckUrl(siteurl) then
blnerror = true
strerror = strerror & "
网址不正确！"
end if
if not isnumeric(webtype) then
blnerror=true
strerror=strerror & "
请正确选择网站类型！"
end if
if len(password)<4 then
blnerror=true
strerror=strerror & "
您的密码太短了！"
end if
if password<>pwdconfirm then
blnerror=true
strerror=strerror & "
两次密码不相同！"
end if
end if
if blnerror=false then
dim rs,sql
set rs=hx.execute("select username from CL_Link where username='"&username&"'")
if not rs.eof then
blnerror=true
strerror=strerror & "
抱歉，用户名已经存在，请重新选择一个用户名"
end if
set rs=nothing
end if
if blnerror=false then
'检测是否是同一域名 V1.6新增 051104
if IsDomainLimit = 1 then
dim domain
domain = mid(siteurl,8)
if instr(domain,"/")>0 then
domain = left(domain,instr(domain,"/"))
end if
set rs=hx.execute("select username from CL_Link where siteurl like '%"&domain&"%'")
if not rs.eof then
blnerror=true
strerror=strerror & "
抱歉，此域名已经存在，系统限制一个域名只能注册一次。"
end if
set rs=nothing
end if
end if
if blnerror=true then
response.write strerror
response.write "
<< 返回上一页
"
else
sql="select top 1 * from CL_Link"
set rs=server.CreateObject("adodb.recordset")
rs.open sql,conn,1,2
rs.AddNew
rs("username")=username
rs("email")=email
rs("sitename")=sitename
rs("webtype")=webtype
rs("password")=md5(password,16)
rs("siteurl")=siteurl
rs("siteintro")=siteintro
rs("sitelogo")=sitelogo
if IsVerify = 1 then
rs("isverify")=0 '不通过
else
rs("isverify")=1 '通过
end if
rs.Update
rs.close
set rs=nothing
%>
- 申请友情链接成功！！！
- 请尽快加上本站提供的链接代码。如果超过一周没有放上链接，我站将删除贵站的资料。
- 只有在你的主页上加入我站的链接后并点击一次后才有可能在我的主页上显示你的链接，并开始统计点击数。
<%if IsVerify = 1 then%>
- 本站设置了注册的网站需要管理员审核才能显示，请注册后耐心等待管理员审核或者直接联系管理员。如果您的网站上没有放置链接代码或者没有至少1次点入来源，可能通不过审核。
<%end if%>
- 点击越多，排名越前，前<%=LineLogo*LineNum%>名可以显示图标，其它则显示文字。
- 站长推荐贵站使用文字链接，如果您愿意使用图标链接，请将图片拷贝到您的服务器上，这样的好处有：1.增加贵站页面上显示此logo的速度，2.减少我站流量，谢谢！
<%
end if
end sub
'邮箱验证
Function CheckEmail(str)
Dim re,a
Set re = New RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = "\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*"
a = re.Test(str)
If a then
CheckEmail = True
Else
CheckEmail = False
End If
end function
'网址验证
Function CheckUrl(str)
Dim re,a
Set re = New RegExp
re.Pattern = "^https?:\/\/[\u4E00-\u9FA5a-zA-Z\.\/0-9]{3,}[\u4E00-\u9FA5a-zA-Z\/0-9]{2,}$"
re.IgnoreCase = False
a = re.Test(str)
If a Then
CheckUrl = true
Else
CheckUrl = false
End If
End Function
%>
