addlink.asp

▲ 程序名称: 天天DV网智能友情链接管理系统 ▲ 程序版本: TTLink V2.3 ▲ 更新日期: 2006年4月3日 ▲ 程序作者: 天天DV网 ▲ 程序测试: http:/

'end if
if not isnumeric(webtype) then
	blnerror=true
	strerror=strerror & "<li>请正确选择网站类型！</li>"
end if
if len(password)<4 then 
	blnerror=true
	strerror=strerror & "<li>您的密码太短了！</li>"
end if
if password<>pwdconfirm then
	blnerror=true
	strerror=strerror & "<li>两次密码不相同！</li>"
end if
if answer<>answerconfirm then
	blnerror=true
	strerror=strerror & "<li>两次密码答案不相同！</li>"
end if
if problem=answer then
	blnerror=true
	strerror=strerror & "<li>密码问题与密码答案不要相同！</li>"
end if

end if

if blnerror=false then
	dim rs,sql
	set rs=hx.execute("select username from tt_Link where username='"&username&"'")
	if not rs.eof then
		blnerror=true
		strerror=strerror & "<li>抱歉，用户名已经存在，请重新选择一个用户名</li>"		
	end if
	set rs=nothing	
end if

if blnerror=false then
'检测是否是同一域名 V1.6新增 051104
if IsDomainLimit = 1 then
	dim domain
	domain = mid(tturl,8)
	if instr(domain,"/")>0 then
	domain = left(domain,instr(domain,"/"))
	end if
	set rs=hx.execute("select username from tt_Link where tturl like '%"&domain&"%'")
	if not rs.eof then
		blnerror=true
		strerror=strerror & "<li>抱歉，此域名已经存在，系统限制一个域名只能注册一次。</li>"		
	end if
	set rs=nothing		
end if
end if


if blnerror=true then
	response.write strerror
	response.write "<p><< <a href=""javascript:history.go(-1)"">返回上一页 </a></p>"
else
	sql="select top 1 * from tt_Link"
	set rs=server.CreateObject("adodb.recordset")
	rs.open sql,conn,1,2
	rs.AddNew
	rs("username")=username
	rs("email")=email
	rs("maillist")=maillist	
	rs("ttname")=ttname
	rs("webtype")=webtype
	rs("password")=md5(password)
	rs("problem")=problem
	rs("answer")=md5(answer)	
	rs("tturl")=tturl
	rs("ttinfo")=ttinfo
	rs("ttlogo")=ttlogo 
	if IsVerify = 1 then
		rs("isverify")=0	'不通过
	else
		rs("isverify")=1	'通过
	end if
	rs.Update
	rs.close
	set rs=nothing	

if emailkg=1 then
'获得信息发送邮件
dim welcome,mailbody,tmpt,jmail,ErrStr
welcome= ""&ttname&"在【"&webname&"】申请的友情链接代码"
mailbody = "恭喜您，贵站－"&ttname&"在【"&webname&"】申请的友情链接成功！谢谢您的信任和支持，本站将尽快审核！请及时将友情链接代码加在您站上，并点击进入本站一次，以免耽误审核时间。<br><b>本站链接代码：</b><br>站名：<font color=#FF6600>"&webname&"</font><br>网址：<font color=red>http://"&hx.BaseUrl&"ttindex.asp?id="&username&"</font><br>LOGO：http://"&hx.BaseUrl&"images/logo.gif<br>简介：<font color=red>"&WebAlt&"</font>"

'jmail邮件组件发送邮件开始，下面的值要先取得
Set jmail = Server.CreateObject("JMail.Message") 
jmail.silent = true '屏蔽例外错误，返回FALSE跟TRUE两值
jmail.Logging = true '启用邮件日志
jmail.Charset = "gb2312"  '邮件的文字编码为国标
jmail.ContentType = "text/html"    '邮件的格式为HTML格式
jmail.MailServerUserName = servemail '输入smtp服务器验证登陆名 （邮局中任何一个用户的Email地址） 
jmail.MailServerPassword = servekey '输入smtp服务器验证密码 （用户Email帐号对应的密码） 
jmail.From = webemail '发信人信箱，因有的服务器反垃圾邮件，此信箱最好与发信服务器同域用户的信箱！ 
jmail.FromName = webname '发件人姓名或公司名 
jmail.AddRecipient email '收件人Email 
jmail.Subject = welcome '邮件的标题 
jmail.Body = mailbody '邮件的内容
 'jmail.Prority = 1      '邮件的紧急程序,必须服务器支持，1 为最快，5 为最慢， 3 为默认值 
jmail.Send (servesmtp) '执行邮件发送smtp服务器地址（企业邮局地址）
ErrStr =jmail.errormessage '允许错误 
set jmail = nothing '关闭对象
'邮件发送结束
if ErrStr = "" then
response.Write "<script language=javascript>alert('恭喜！申请友情链接成功,请尽快把链接代码放上您站，并点击进入本站一次。系统已发送一封邮件到您的信箱。');</script>"	
else
response.Write "<script language=javascript>alert('申请成功！等待审核。请尽快把链接代码放上您站，并点击进入本站一次。');</script>"
end if	'发送结果判断结束
else
response.Write "<script language=javascript>alert('申请成功！等待审核。请尽快把链接代码放上您站，并点击进入本站一次。');</script>"
end if

%>
  <ul>
    <li><strong><font color="#FF0000">恭喜，申请友情链接成功！！！</font></strong></li>
    <%if IsVerify = 1 then%>
    <li>本站设置了注册的网站需要管理员审核才能显示，请注册后耐心等待管理员审核或者直接联系管理员。</li>
    <%end if%>    
    <li>请尽快加上本站提供的链接代码。如果超过一周没有放上链接，我站将删除贵站的资料。</li>
    <li>只有在你的主页上加入我站的链接后并点击一次后才有可能在我的主页上显示你的链接，并开始统计点击数。</li>
    <li>点入贡献越多，排名越前，前<%=LineLogo*LineNum%>名可以显示图标，其它则显示文字。</li>
    <li>站长推荐贵站使用文字链接，如果您愿意使用图标链接，请将图片拷贝到您的服务器上，可加快贵站显示此logo速度，并减少本站流量，谢谢！</li>
  </ul>
  <table width="100%" border="0" align="center">
    <tr valign="top">
      <td width="50%"><p>文字链接 <font color="#0000FF">代码：</font><br>
          <textarea name="textarea" style="width:96%;height:80px;"><a href="http://<%=hx.BaseUrl%>ttindex.asp?id=<%=username%>" target="_blank" title="<%=WebAlt%>"><%=WebName%></a></textarea>
        <p><font color="#0000FF">显示样式：</font><a href="http://<%=hx.BaseUrl%>ttindex.asp?id=<%=username%>" target="_blank" title="<%=WebAlt%>"><%=WebName%></a></p></td>
      <td width="50%"><p>图标链接<font color="#0000FF"> 代码：</font><br>
          <textarea name="textarea2" style="width:96%;height:80px;"><a href="http://<%=hx.BaseUrl%>ttindex.asp?id=<%=username%>" target="_blank"><img src="http://<%=hx.BaseUrl%>images/logo.gif" width="88" height="31" alt="<%=WebAlt%>" border="0"></a></textarea>
        </p>
        <p><font color="#0000FF">显示样式：</font><a href="http://<%=hx.BaseUrl%>ttindex.asp?id=<%=username%>" target="_blank"><img src="http://<%=hx.BaseUrl%>images/logo.gif" width="88" height="31" alt="<%=WebAlt%>" border="0"></a></p></td>
    </tr>
  </table>  
  <%
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
%>
</div>
<!--#include file="under.asp"-->
<%set hx=nothing%>
</body>
</html>