register.asp

此程序是一个个人主页创造程序,该程序无插件,无任何恶意程序.

		else
			strsql = strsql & ", ' '"
		end if
' ########## www.wormcn.net 自定义表情图片 ##########
		if strPicture = "1" then
			strsql = strsql & ", '" & ChkString(regPhoto_URL,"") & "'"
		else
			strsql = strsql & ", ' '"
		end if
		if strPicture = "1" then
			if regPhoto_Width<>"" then
				strsql = strsql & ", " & regPhoto_Width
			end if
		end if
		if strPicture = "1" then
			if regPhoto_Height<>"" then
				strsql = strsql & ", " & regPhoto_Height
			end if
		end if
' ########## www.wormcn.net 自定义表情图片 ##########
		if strFavLinks = "1" then
			if Request.Form("LINK1")<>"" then
				strsql = strsql & ", '" & ChkString(Request.Form("LINK1"),"") & "'"
			else
				strsql = strsql & ", ' '"
			end if
			if Request.Form("LINK2")<>"" then
				strSql = strSql & ", '" & ChkString(Request.Form("LINK2"),"") & "'"
			else
				strsql = strsql & ", ' '"
			end if
		end if
		if strAge = "1" then
			strSql = strsql & ", '" & ChkString(Request.Form("Age"),"") & "'"
		else
			strSql = strsql & ", ' '"
		end if
		if strMarStatus = "1" then
			strSql = strSql & ", '" & ChkString(Request.Form("MarStatus"),"") & "'"
		else
			strSql = strSql & ", ''"
		end if
		if strSex = "1" then
			strSql = strsql & ", '" & ChkString(Request.Form("Sex"),"") & "'"
		else
			strSql = strSql & ", ''"
		end if
		if strOccupation = "1" then
			strSql = strSql & ", '" & ChkString(Request.Form("Occupation"),"") & "'"
		else
			strSql = strSql & ", ' '"
		end if
		if strBio = "1" then
			strSql = strSql & ", '" & ChkString(Request.Form("Bio"),"message") & "'"
		else
			strSql = strSql & ", ''"
		end if
		if strHobbies = "1" then
			strSql = strSql & ", '" & ChkString(Request.Form("Hobbies"),"message") & "'"
		else
			strSql = strSql & ", ''"
		end if
		if strLNews = "1" then
			strsql = strsql & ", '" & ChkString(Request.Form("LNews"),"message") & "'"
		else
			strSql = strSql & ", ''"
		end if
		if strQuote = "1" then
			strSql = strSql & ", '" & ChkString(Request.Form("Quote"),"message") & "'"
		else
			strSql = strSql & ", ''"
		end if
		'########################### PM RECEIVE #####################
		strSql = strsql & ", 1"
		'########################### PM RECEIVE #####################

		'########################### PM NEW MEMBER #####################
		strSql = strsql & ", 1"
		'########################### PM NEW MEMBER #####################
		strSql = strSql & ")"

		my_Conn.Execute (strSql)
		
		docount
		
		regHomepage = ""
		
'########################### PM NEW MEMBER #####################
if intNewMemPM = "1" then
	Dim objDict
	Set objDict = Server.CreateObject("Scripting.Dictionary")
	set objRec = my_Conn.execute("SELECT * FROM " & strTablePrefix & "MODS WHERE M_NAME = 'NewMemPM'")

	while not objRec.EOF
	  objDict.Add objRec.Fields.Item("m_code").Value, objRec.Fields.Item("m_value").Value
	  objRec.moveNext
	wend

	Admin = GetMemberID(objDict.Item("Admin"))
	Subject = objDict.Item("Subject")
	Message = objDict.Item("Message")

	strSql = "INSERT INTO " & strTablePrefix & "PM "
	strSql = strSql & "(M_SUBJECT"
	strSql = strSql & ", M_FROM"
	strSql = strSql & ", M_TO"
	strSql = strSql & ", M_SENT"
	strSql = strSql & ", M_MESSAGE"
	strSql = strSql & ", M_PMCOUNT"
	strSql = strSql & ", M_READ"
	strSql = strSql & ", M_MAIL"
	strSql = strSql & ", M_OUTBOX"
	strSql = strSql & ") "
	strSql = strSql & " VALUES ("
	strSql = strSql & "'" & Subject & "'"
	strSql = strSql & ", " & "'" & Admin & "'"
	strSql = strSql & ", " & "'" & GetMemberID( Request.Form("Name")) & "'"
	strSql = strSql & ", " & "'" & DateToStr(strForumTimeAdjust) & "'"
	strSql = strSql & ", " & "'" & Message & "'"
	strSql = strSql & ", " & "'1'"
	strSql = strSql & ", " & "'0'"
	strSql = strSql & ", " & "'0'"
	strSql = strSql & ", " & 1 & ")"
	
	my_Conn.Execute (strSql)
end if
'########################### PM NEW MEMBER #####################

'Rem User Field Code #######################################
			if (strUseExtendedProfile) then
				if (intUserFields > 0) then
					Dim UpdSQL, memID
					memID = getMemberID(Request.Form("Name"))
					UserstrSql = "SELECT * "
					UserstrSql = UserstrSql & " FROM " & strTablePrefix & "USERFIELDS "
					set rsIDs = my_Conn.Execute(UserstrSql)
					do until rsIDs.EOF
						sInputName = rsIDs("USR_SHORTNAME")
						If Request.Form(sInputName)<>"" then
							UpdSql = "INSERT INTO " & strMemberTablePrefix & "MEMBERFIELDS "
							UpdSql = UpdSql & "VALUES ( '" & memID & "','" & rsIDs("USR_FIELD_ID") & "','"
							UpdSql = UpdSql & Request.Form(sInputName) & "')"
							my_Conn.Execute(UpdSQL)
						end if
						rsIDs.MoveNext
					loop
					SET UpdSQL = Nothing
					SET memID = Nothing
					rsIDs.Close
				end if
			end if
'Rem User Field Code #######################################

		if lcase(strEmail) = "1" then
			'## Emails Message to the Author of this Reply.
			'## This needs to be Edited to use your own email component
			'## if you don't have one, try the w3Jmail component from www.dimac.net it's free!
			strRecipientsName = Request.Form("Name")
			strRecipients = Request.Form("Email")
			strFrom = strSender
			strFromName = strForumTitle
			strsubject = "『" & strForumTitle & "』注册通知"
			strMessage = "Hello, " & Request.Form("name") & ":" & vbCrLf & vbCrLf
			strMessage = strMessage & "这是一封来自 『" & strForumTitle & "』 的注册通知，恭喜你注册成功，现在" & vbCrLf & vbCrLf
			strMessage = strMessage & "你可以在 " & strForumURL & " 发表新文章或回复文章并且可以使用我们所提供的资源。" & vbCrLf & vbCrLf
			if strAuthType="db" then
				strMessage = strMessage & "您的论坛ID：" & Request.Form("name") & vbCrLf
				strMessage = strMessage & "您的密码是：" & Request.Form("Password") & vbCrLf & vbCrLf
			end if
			strMessage = strMessage & "你可以经由点击""资料""来修改你的资料" & vbCrLf & vbCrLf
			strMessage = strMessage & "赶快加入论坛吧！" & vbCrLf & vbCrLf
			strMessage = strMessage & "论坛首页：" & strForumURL & vbCrLf & vbCrLf
			strMessage = strMessage & "中国在线 ChinaXP.Net " & strVersionNumber & "  演示直通车: http://www.chinaxp.net/bbs/"
%>
<!--#INCLUDE FILE="inc_mail.asp" -->
<%
		end if
	else
		if (InStr(Request.ServerVariables("HTTP_REFERER"), "policy.asp") <> 0) or (Err_Msg <> "") then
%>

	<p align=center><font face="<% =strDefaultFontFace %>" size="<% =strHeaderFontSize %>">你输入的资料有问题或没有填写完整</font></p>

	<table align=center border=0>
	  <tr>
	    <td><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>">
		<ul>
		<% =Err_Msg %>
		</ul>
	    </font></td>
	  </tr>
	</table>

	<p align=center><font face="<% =strDefaultFontFace %>" size=<% =strDefaultFontSize %>><a href="JavaScript:history.go(-1)">请返回重新输入</a></font></p>
<!--#INCLUDE FILE="inc_adv.asp" -->
<!--#INCLUDE FILE="inc_footer.asp" -->
<%		Response.End %>

<%			call ShowForm %>
<%'			On Error Resume next %>
<%			my_Conn.Close %>
<%			set my_Conn = nothing %>
<%			Response.End %>
<%		else %>
	<p align=center><font face="<% =strDefaultFontFace %>" size="<% =strHeaderFontSize %>">发现错误</font></p>
    <p align=center><font face="<% =strDefaultFontFace %>" size=<% =strDefaultFontSize %>>You must first read the disclaimer/privacy statement by clicking on &quot;<a href="policy.asp">register</a>&quot; link in the main forum window.</p>
    <p align="center"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><a href="JavaScript:history.go(-1)">返回修正问题。</a></font></p>
	<!--#INCLUDE FILE="inc_adv.asp" -->
    <!--#INCLUDE FILE="inc_footer.asp" -->
<%			Response.End %>
<%		end if %>
<%	end if %>
	<p align=center><font face="<% =strDefaultFontFace %>" size="<% =strHeaderFontSize %>">你的注册已经完成！</font></p>
	<p align=center><font face="<% =strDefaultFontFace %>" size=<% =strDefaultFontSize %>>你现在可以发表文章<% if strAuthType="db" then %>使用你的新用户名和密码<% end if %>。</font></p>
<%
	if strAuthType = "db" then

		select case ChkUser2(Request.Form("Name"), Request.Form("Password"))
			case 1, 2, 3, 4
				Call DoCookies("false")
				strLoginStatus = 1
			case else
				strLoginStatus = 0
		end select
	end if
%>
<%	If strAutoLogon = 1 then
  		Response.Redirect "default.asp"
	Else %>
		<meta http-equiv="Refresh" content="2; URL=<% =Request.Form("refer")%>">
<%	End if %>
    <p align="center"><font face="<% =strDefaultFontFace %>" size="<% =strDefaultFontSize %>"><a href="<% =Request.Form("refer")%>">返回论坛</font></a></p>
<% end if %>
<%' On Error Resume next %>
<!--#INCLUDE FILE="inc_adv.asp" -->
<!--#INCLUDE FILE="inc_footer.asp" -->
<%
sub DoCount

	'## Forum_SQL - Updates the Totals table by adding 1 to U_COUNT
	strSql = "UPDATE " & strTablePrefix & "TOTALS "
	strSql = strSql & " SET " & strTablePrefix & "TOTALS.U_COUNT = " & strTablePrefix & "TOTALS.U_COUNT + 1"

	my_Conn.Execute (strSql)

end sub

function chkNameBadWords(fString)
	bwords = split(strBadWords, "|")
	for i = 0 to ubound(bwords)
		if instr(fString, bwords(i)) <> 0 then
			Err_Msg = Err_Msg & "<li><font color=red>" & "这个ID已经被禁止使用: " & bwords(i) & " ;</font></li>"
			exit function
		end if
	next
end function

Function IsValidString(sValidate)

	Dim sInvalidChars
	Dim bTemp, i
	' 不允许使用的字符
	sInvalidChars = "!#$%^&*()=+{}[]|\;:/?>,<"
	For i = 1 To Len(sInvalidChars)
		If InStr(sValidate, Mid(sInvalidChars, i, 1)) > 0 Then bTemp = True
		If bTemp Then Exit For
	Next
	For i = 1 To Len(sValidate)
		If Asc(Mid(sValidate, i, 1)) = 160 Then bTemp = True
		If bTemp Then Exit For
	Next

	' 不允许连续的两个空格或者"."
	if not bTemp then
		bTemp = InStr(sValidate, "..") > 0
	end if
	if not bTemp then
		bTemp = InStr(sValidate, "	") > 0
	end if
	' 不允许两端有空格
	if not bTemp then
		bTemp = (len(sValidate) <> len(Trim(sValidate)))
	end if

	IsValidString = Not bTemp
End Function

sub ShowForm() %>
<form action="register.asp?mode=DoIt" method="post" id=Form1 name=Form1>
<input name="Refer" type="hidden" value="<% =Request.Form("Refer") %>">
<table width="400" border=0 align=center>
  <tr>
    <td><!--#INCLUDE FILE="inc_profile.asp" --></td>
  </tr>
</table>
</form>
</font>
<% end sub %>