<%
Const WPD_PageSize=20
Const WPD_ActionMoney=10
Const WPD_UpfileSize=100
Const WPD_spcolor="#FF0000"
Const WPD_title_wordnum=20
Const WPD_content_wordnum=250
Dim rs,sql,i
Dim CONN,Db
Dim Startime,Endtime
Dim WPD_cookiepath,WPD_Forum_info,WPD_faceWidth,WPD_faceHeight

DEF_BBS_homeUrl = "../../"
''============================下面修改====================================
Db="/Service/visual/visual_data/dfrbgfhrtrt_visual.mdb"
WPD_Forum_info=Split("孝感文昌阁社区,孝感文昌阁社区,文昌阁社区,www.xgcity.com,xgcity.com",",")
''============================修改结束=====================================
Startime=Timer()

Function OpenPlusDatabase
	Dim ConnStr
		'旧版数据库
	'connstr="driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath(db)
		'新版数据库
	ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(db)
	Set conn = Server.CreateObject("ADODB.Connection")
	conn.open ConnStr
	If Err Then
		err.Clear
		Set Conn = Nothing
		Response.Write "数据连接错误!"
		Response.End
	End If
End Function

Function ClosePlusDatabase
	Conn.Close
	Set Conn = Nothing
End Function

Opendatabase
Openplusdatabase
Dim WPD_ScriptName,WPD_IsShowTop
Dim WPD_Stats,WPD_Templateurl
Dim WPD_Errmsg,WPD_Sucmsg
Dim WPD_SkinName,WPD_Forum_picPath,WPD_Forum_body,WPD_Badwords
Dim WPD_MemberName,WPD_UserID,WPD_MemberClass
Dim WPD_vipuser,WPD_boardmaster,WPD_superboardmaster,WPD_master
Dim WPD_myuserep,WPD_mysex,WPD_myusercp,WPD_mymoney,WPD_mypower,WPD_myArticle
Dim WPD_FoundUser,WPD_FoundErr
Dim WPD_bbspath,WPD_pluspath,WPD_bsmoney

WPD_Badwords="妈妈的|我靠|fuck|bitch|他妈的|性爱|法轮功|falundafa|falun|江泽民|操你妈|三级片|xxx|sex|腚|妓|娼|阴蒂|奸|尻|贱|婊|靠|叉|龟头|屄|赑|妣|肏|尻|屌"
WPD_boardmaster=false
WPD_superboardmaster=false
WPD_master=false
WPD_founduser=false
WPD_founderr=false
WPD_ScriptName=WPD_bbspath

Sub WPD_CheckPlusUser()
	dim rs,sql,plustemp(9)
	plustemp(9)=0
	set rs=server.createobject("adodb.recordset")
	sql="select top 1 * from Leadbbs_user where username='"&gbl_chk_user&"'"
	rs.open sql,con,1,1
	If rs.bof and rs.eof then
		response.write "你是游客吧！这里是不允许游客进入的哦~"
		set rs=nothing
		closedatabase
		closeplusdatabase
		response.end
	Else
		plustemp(0)=rs("id")
		plustemp(1)=rs("username")
		plustemp(2)=rs("announcenum")
		 if rs("sex")="女" then
			 plustemp(3)=0
		 else
			 plustemp(3)=1
		 end if
		plustemp(4)=rs("faceurl")
		If plustemp(4)="" then plustemp(4)=""
		plustemp(5)=rs("facewidth")
		plustemp(6)=rs("faceheight")
		 If WPD_GetBit(rs("userlimit"),10)=1 then
			plustemp(7)="总版主"
		 Elseif WPD_GetBit(rs("userlimit"),8)=1 then
			plustemp(7)="版主"
		 Elseif WPD_GetBit(rs("userlimit"),2)=1 then
		 	plustemp(7)="认证社员"
		 	plustemp(9)=1
		 Else
			plustemp(7)="普通社员"
		 End if
		plustemp(8)=fix(rs("points")/WPD_bsmoney)	'money
	End if
	rs.close
	set rs=nothing

	dim rsv,sqlv
	sqlv="select * from [user] where username='"&gbl_chk_user&"'"
	set rsv=server.createobject("adodb.recordset")
	rsv.open sqlv,conn,1,3
	If rsv.bof and rsv.eof then
		rsv.addnew
		rsv("userid")=plustemp(0)
		rsv("username")=plustemp(1)
		rsv("article")=plustemp(2)
		rsv("sex")=plustemp(3)
		rsv("face")=plustemp(4)
		rsv("width")=plustemp(5)
		rsv("height")=plustemp(6)
		rsv("userclass")=plustemp(7)
		rsv("userwealth")=plustemp(8)
		rsv("userEP")=10
		rsv("userCP")=10
		rsv("vip")=plustemp(9)
		rsv.update
	Else
		rsv("userid")=plustemp(0)
		rsv("username")=plustemp(1)
		rsv("article")=plustemp(2)
		rsv("sex")=plustemp(3)
		rsv("face")=plustemp(4)
		rsv("width")=plustemp(5)
		rsv("height")=plustemp(6)
		rsv("userclass")=plustemp(7)
		rsv("userwealth")=plustemp(8)
		rsv("userEP")=10
		rsv("userCP")=10
		rsv("vip")=plustemp(9)
		rsv.update
	End if
	rsv.close
	set rsv=nothing
	If CheckSupervisorUserName = 1 then
		 WPD_master=true
	end if
	Select case plustemp(7)
		case "总版主"
			WPD_memberclass="总版主"
			WPD_superboardmaster=true
		case "版主"
			WPD_memberclass="版主"
			WPD_boardmaster=true
		case "认证社员"
			WPD_memberclass="认证社员"
		case else
			WPD_memberclass="普通社员"		
	End select
	WPD_founduser=true
	WPD_userid=plustemp(0)
	WPD_MemberName=plustemp(1)
	WPD_mysex=plustemp(3)
	WPD_myArticle=plustemp(2)
	WPD_faceWidth=plustemp(5)
	WPD_faceHeight=plustemp(6)
	WPD_vipuser=plustemp(9)
	WPD_mymoney=plustemp(8)
	WPD_myuserep=10
	WPD_myusercp=10
	WPD_mypower=10
End Sub

Function WPD_Checkstr(Str)
	If Isnull(Str) Then
		WPD_checkStr = ""
		Exit Function 
	End If
	WPD_checkStr=Replace(Str,"'","''")
End Function

Sub WPD_GetConfig()
	Dim SQL0,Rs0,ivv
	SQL0="select top 1 * from bbsconfig"
	Set Rs0=server.createobject("adodb.recordset")
	Rs0.open SQL0,Conn,1,1
	If Rs0.EOF And Rs0.BOF Then
		Response.Write "错误的系统参数，请从有效连接进入。</A>。"
		Rs0.close
		Set Rs0=Nothing
		CloseDatabase
		closePlusdatabase
		Response.End
	Else	
		WPD_bbspath=Rs0("bbspath")
		WPD_pluspath=Rs0("pluspath")
		WPD_bsmoney=Rs0("bsmoney")
		WPD_cookiepath=Rs0("cookiepath")
		Rs0.Close 
		Set Rs0=Nothing
	End If
End Sub

Function WPD_HTMLEncode(fString)
	If Not IsNull(fString) Then
	Dim bwords,ii
	fString = replace(fString, ">", "&gt;")
	fString = replace(fString, "<", "&lt;")

	fString = Replace(fString, CHR(32), "&nbsp;")
	fString = Replace(fString, CHR(9), "&nbsp;")
	fString = Replace(fString, CHR(34), "&quot;")
	fString = Replace(fString, CHR(39), "&#39;")
	fString = Replace(fString, CHR(13), "")
	fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
	fString = Replace(fString, CHR(10), "<BR> ")
	
	If not(IsNull(WPD_Badwords)) Then
		bwords = split(WPD_BadWords, "|")
		for ii = 0 to ubound(bwords)
			fString = Replace(fString, bwords(ii), string(len(bwords(ii)),"*")) 
		next
	End If
	WPD_HTMLEncode = fString
	End If
End Function

Function WPD_EncodeJS(str)
	If not IsNull(str) Then
		Dim bwords,ii
		str = replace(str, ">", "&gt;")
		str = replace(str, "<", "&lt;")
		str = replace(str, "\", "\\")
		str = replace(str, chr(34), "\""")
		str = replace(str, chr(39), "\'")
		str = Replace(str, CHR(10) & CHR(10), "\r")
		str = Replace(str, chr(10), "\n")
		str = Replace(str, chr(13), "")
		str = Replace(str, chr(9), "&nbsp;")
	If not(IsNull(WPD_Badwords)) Then
		bwords = split(WPD_BadWords, "|")
		for ii = 0 to ubound(bwords)
			str = Replace(str, bwords(ii), string(len(bwords(ii)),"*")) 
		next
	End If
		WPD_EncodeJS=str
	End If
End Function

Function WPD_SimEncodeJS(str)
	If Not IsNull(str) Then
		str = replace(str, "\", "\\")
		str = replace(str, chr(34), "\""")
		str = replace(str, chr(39), "\'")
		str = Replace(str, chr(10), "\n")
		str = Replace(str, chr(13), "\r")
		WPD_SimEncodeJS=str
	End If
End Function

'将JS过滤还原
Function WPD_JScodeToHtml(str)
	If Not IsNull(str) Then
		str = replace(str, "\n", "")
		str = replace(str, "\r", "")
		str = replace(str, "\""", """")
		WPD_JScodeToHtml=str
	End If
End Function

'过滤表单字符
Function WPD_HTMLcode(fString)
	If not IsNull(fString) Then
	fString = Replace(fString, CHR(13), "")
	fString = Replace(fString, CHR(10) & CHR(10), "</P><P>")
	fString = Replace(fString, CHR(10), "<BR>")
	WPD_HTMLcode = fString
	End If
End Function

function WPD_newincept()
	dim rs8
	rs8=conn.execute("Select Count(id) From Message Where flag=0 and issend=1 and delR=0 And incept='"& WPD_membername &"'")
	    WPD_newincept=rs8(0)
	set rs8=nothing
	if isnull(WPD_newincept) then WPD_newincept=0
end function

Function WPD_Footer()
	CloseDatabase
	ClosePlusDataBase
	Endtime=Timer()
	WPD_ScriptStart	
	If WPD_ISShowTop=1 Then 
		Response.Write "WPD_footer('"
	Else
		Response.Write "WPD_footer0('"
	End If
	Response.Write FormatNumber((Endtime-Startime)*1000,3)
	Response.Write "');"
	WPD_ScriptEnd()
End Function

Rem 判断数字是否整形
Function WPD_isInteger(Para)
     on error resume next
     dim str
     dim l,i
     if isNUll(para) then 
       WPD_isInteger=false
       exit function
    end if
    str=cstr(para)
    if trim(str)="" then
       WPD_isInteger=false
       exit function
     end if
     l=len(str)
     for i=1 to l
         if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
           WPD_isInteger=false 
           exit function
        end if
    next
    WPD_isInteger=true
    if err.number<>0 then err.clear
End Function

Function WPD_html()	
	Response.Write "<html>"
	Response.Write Chr(10)		
	Response.Write "<head>"
	Response.Write Chr(10)
	Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
	Response.Write Chr(10)
	Response.Write "<meta name=keywords content=""LEON社区，LEON社区,ASP，ASP技术，ASP社区，插件，下载，时尚秀，WPD"">"
	Response.Write Chr(10)
	Response.write"<meta name=""description"" content=""WPD,Wxz_Plus_Document,Wxz插件作品"">"
	Response.Write Chr(10)
	WPD_ScriptStart	
	Response.Write "function openScript(url, width, height){"
	Response.Write Chr(10)
	Response.Write "var Win = window.open(url,""openScript"",'width=' + width + ',height=' + height + ',resizable=1,scrollbars=yes,menubar=no,status=yes' );"
	Response.Write Chr(10)
	Response.Write "}"
	Response.Write Chr(10)
	Response.Write "function CheckAll(form)  {"
	Response.Write Chr(10)
	Response.Write "  for (var i=0;i<form.elements.length;i++)    {"
	Response.Write Chr(10)
	Response.Write "    var e = form.elements[i];"
	Response.Write Chr(10)
	Response.Write "    if (e.name != 'chkall')       e.checked = form.chkall.checked;" 
	Response.Write Chr(10)
	Response.Write "   }"
	Response.Write Chr(10)
	Response.Write "}"
	WPD_ScriptEnd	
End Function

Function WPD_head()
	Dim Temp
	If GBL_SiteHeadString = "" and GBL_SiteBottomString = "" Then
		Temp = Left(Request.Cookies(DEF_MasterCookies & "style")("border" & GBL_board_ID),14)
		If isNumeric(Temp) = 0 or Temp="" Then Temp = -1
		Temp = cCur(Temp)
		If Temp >= 0 and Temp <= DEF_BoardStyleStringNum Then GBL_Board_BoardStyle = Temp
	End If

	If GBL_Board_BoardStyle > DEF_BoardStyleStringNum Then GBL_Board_BoardStyle = DEF_BoardStyleStringNum
	GBL_Board_BoardStyle = cCur(GBL_Board_BoardStyle)

	Temp = application(DEF_MasterCookies & "Style" & GBL_Board_BoardStyle)
	If isArray(Temp) = False Then
		If Temp & "" <> "yes" Then
			If GBL_ConFlag = 1 Then ReloadBoardStyleInfo(GBL_Board_BoardStyle)
			Temp = application(DEF_MasterCookies & "Style" & GBL_Board_BoardStyle)
		End If
	End If
	If isArray(Temp) = True Then
		DEF_BBS_ScreenWidth = RTrim(Temp(1,0))
		DEF_BBS_DisplayTopicLength = Temp(2,0)
		GBL_DefineImage = Temp(3,0)
		If GBL_DefineImage = True or GBL_DefineImage = 1 Then
			GBL_DefineImage = "Skin/" & GBL_Board_BoardStyle & "/"
		Else
			GBL_DefineImage = ""
		End If
		If GBL_SiteHeadString = "" Then GBL_SiteHeadString = Temp(4,0)
		If GBL_SiteBottomString = "" Then GBL_SiteBottomString = Temp(5,0)
		GBL_TableHeadString = Temp(6,0)
		GBL_TableBottomString = Temp(7,0)
		GBL_ShowBottomSure = Temp(8,0)
	End If
	Response.Write Chr(10)
	Response.Write "<link rel=stylesheet type=text/css href="&DEF_BBS_homeUrl&"inc/style"&GBL_Board_BoardStyle&".css>"
	Response.Write Chr(10)
	Response.Write "<title>"&WPD_Forum_Info(0)&"-"&WPD_Stats&"</title>"
	Response.Write Chr(10)
	Response.Write "<style type=""text/css"">"
	Response.Write Chr(10)
	Response.Write "input{border:1px solid #AAAAAA;height:20px;font:""menu"";}"
	Response.Write Chr(10)
	Response.Write "select{BORDER-RIGHT:#666666 1px solid;BORDER-TOP:#666666 1px solid;FONT-SIZE:9pt;BORDER-LEFT:#666666 1px solid;BORDER-BOTTOM:#666666 1px solid;}"
	Response.Write Chr(10)
	Response.Write "</style>"
	Response.Write Chr(10)
	Response.Write "</head>"
	Response.Write Chr(10)
	Response.Write "<body bgcolor="&DEF_BBS_LightestColor&" leftmargin=0 topmargin=0 marginwidth=0 marginheight=0 class=TBBGbody>"
	Response.Write Chr(10)
	Response.Write "<div id=""menuDiv"" style=""Z-INDEX: 2; WIDTH: 1px; POSITION: absolute; HEIGHT: 1px; BACKGROUND-COLOR: #9cc5f8; visibility: hidden""></div>"
	Response.Write Chr(10)
	If WPD_IsShowtop=1 Then
		call WPD_Showtop()
	End If
	If WPD_founduser=false Then
		WPD_Errmsg="<li>您没有使用本社区插件的权限，请登录或者同管理员联系。</li>"		
		WPD_stats="错误信息"
		WPD_Error
		response.end 
	End If
End Function

Function WPD_ShowTop()
	If GBL_SiteHeadString <> "" Then
		Response.Write GBL_SiteHeadString
	Else
		Response.Write Chr(10)
		Response.Write "<table width="&DEF_BBS_ScreenWidth&" cellspacing=1 cellpadding=0 align=center bgcolor="&DEF_BBS_LightestColor&" class=TBBG9>"
		Response.Write Chr(10)
		Response.Write "<TR><TD align=left width=""25%""><img border=0 src="&WPD_Forum_Info(6)&"></TD>"
		Response.Write Chr(10)
		Response.Write "<TD Align=center width=""65%""><img src="&WPD_plusPath&"images/banner.gif border=0></td><td align=""right"" style=""line-height: 15pt;"" width=""10%"">"
		Response.Write "加入收藏"
		Response.Write Chr(10)
		Response.Write "<br><a href=""mailto:"&WPD_Forum_Info(5)&""">与我联系</a><br><a href="&WPD_bbspath&"user/help/help.asp>社区帮助</a>"
		Response.Write Chr(10)
		Response.Write "</td></tr></table></table>"
		Response.Write Chr(10)
	End If
End Function

Function WPD_ShowNav(filename,filepath,filelink)
	Response.Write Chr(10)
	Response.Write "<table width="&DEF_BBS_ScreenWidth&" cellspacing=1 cellpadding=5 align=center class=NavColor1>"
	Response.Write Chr(10)
	Response.Write "<tr>"
	Response.Write Chr(10)
	Response.Write "<td>"
	Response.Write Chr(10)	
	Response.Write "<img border=0 src="&WPD_plusPath&"images/forum_nav.gif align=absmiddle>&nbsp;<a href="&WPD_bbspath&">"&WPD_Forum_info(0)&"</a>"
	If filename<>"" then
	Response.Write " >> "&"<a href="&WPD_pluspath&filepath&"/"&filelink&">"&filename&"</a>"
	End if
	Response.Write " >> "&WPD_stats
	Response.Write Chr(10)
	Response.Write "</td><td align=right>"
	Response.Write Chr(10)
	call WPD_CheckMysms()
	Response.Write Chr(10)
	Response.Write "</td></tr></table><br>"
	Response.Write Chr(10)
End Function

Function WPD_StrLength(str)

	If IsNull(str) or Str = "" Then
		WPD_StrLength = 0
		Exit Function
	End If
	
	Dim WINNT_CHINESE
	WINNT_CHINESE=(len("感悟")=2)
	If WINNT_CHINESE Then
		Dim l,t,c
		Dim i
		l=len(str)
		t=l
		For i=1 to l
			c=asc(mid(str,i,1))
			If c<0 Then c=c+65536
			If c>255 Then
				t=t+1
			End If
		Next
		WPD_strLength=t
	Else 
		WPD_strLength=Len(str)
	End If
End Function

Function WPD_cutStr(str,strlen)
	Dim l,t,c,i
	l=Len(str)
	t=0
	For i=1 to l
		c=Abs(Asc(Mid(str,i,1)))
		If c>255 Then
			t=t+2
		Else
			t=t+1
		End If
		If t>=strlen Then
			cutStr=left(str,i)&"..."
			Exit For
		Else
			cutStr=str
		End If
	Next
	WPD_cutStr=replace(cutStr,chr(10),"")
End Function

Sub WPD_header(filename,filepath,filelink)
	WPD_head
	If WPD_IsShowtop=1 Then
	call WPD_ShowNav(filename,filepath,filelink)
	End If
End Sub
Sub WPD_ScriptSrc(JsFile)
	Response.Write"<script language=""JavaScript"" src="""
	Response.Write JsFile
	Response.Write"""></script>"
End Sub
Sub WPD_ScriptStart()
	Response.Write "<SCRIPT LANGUAGE=""JavaScript"">"
	Response.Write chr(10)
	Response.Write "<!--WPD,Wxz_Plus_Document,Wxz插件作品"
	Response.Write chr(10)
End Sub
Sub WPD_ScriptEnd()
	Response.Write chr(10)
	Response.Write "//-->"
	Response.Write chr(10)
	Response.Write "</SCRIPT>"
End Sub

Function WPD_Get_ScriptNameUrl(MyScriptName)
	If request.servervariables("SERVER_PORT")="80" Then
		WPD_Get_ScriptNameUrl="http://" & request.servervariables("server_name")&replace(lcase(request.servervariables("script_name")),MyScriptName,"")
	Else
		WPD_Get_ScriptNameUrl="http://" & request.servervariables("server_name")&":"&request.servervariables("SERVER_PORT")&replace(lcase(request.servervariables("script_name")),MyScriptName,"")
	End If
End Function

Function WPD_ChkBadWords(fString)
	Dim bwords,ii
	If Not(IsNull(WPD_Badwords) or isnull(fString)) Then
		bwords = split(WPD_Badwords, "|")
		For ii = 0 to UBound(bwords)
			fString = Replace(fString, bwords(ii), string(len(bwords(ii)),"*")) 
		Next
		WPD_ChkBadWords = fString
	End If
End Function

function WPD_Cutmoney(mtmoneynum,mtusername,beishu)
	dim mtrs,mtsql,realmoney
	realmoney=mtmoneynum*beishu
	if not isNumeric(realmoney) then
		realmoney=10000
	else
		realmoney=cLng(realmoney)
	end if
	set mtrs=server.createobject("adodb.recordset")
	mtsql="select * from [Leadbbs_user] where username='"&mtusername&"'"
	mtrs.open mtsql,con,1,3
	if mtrs.bof and mtrs.eof then
		response.write "<br><br><br><br><br><br><br><br><br>社区插件区不存在此社员！"
		response.end
	else
		if mtrs("points") < realmoney then
			mtrs("points")=0
		else
			mtrs("points")=mtrs("points")-realmoney
		end if
		mtrs.update
	end if
	mtrs.close
	set mtrs=nothing
end function
function WPD_Addmoney(mtmoneynum,mtusername,beishu)
	dim mtrs,mtsql,realmoney
	realmoney=mtmoneynum*beishu
	if not isNumeric(realmoney) then
		realmoney=10000
	else
		realmoney=cLng(realmoney)
	end if
	set mtrs=server.createobject("adodb.recordset")
	mtsql="select * from [Leadbbs_user] where username='"&mtusername&"'"
	mtrs.open mtsql,con,1,3
	if mtrs.bof and mtrs.eof then
		response.write "<br><br><br><br><br><br><br><br><br>社区插件区不存在此社员！"
		response.end
	else
		mtrs("points")=mtrs("points")+realmoney
		mtrs.update
	end if
	mtrs.close
	set mtrs=nothing
end function
sub WPD_error()
	Response.Write Chr(10)
	Response.Write "<table width="&DEF_BBS_ScreenWidth&" cellspacing=1 cellpadding=3 align=center bgcolor="&DEF_BBS_DarkColor&" class=TBone>"
	Response.Write Chr(10)
	Response.Write "<tr align=center bgcolor="&DEF_BBS_LightDarkColor&">"
	Response.Write Chr(10)
	Response.Write "<td class=TBHead><font color=#ffffff class=HeadFont><b>社区错误信息</b></font></td>"
	Response.Write Chr(10)
	Response.Write "</tr>"
	Response.Write Chr(10)
	Response.Write "<tr bgcolor="&DEF_BBS_LightestColor&" class=TBBG9>"
	Response.Write Chr(10)
	Response.Write "<td>"
	Response.Write Chr(10)
	Response.Write "<b>产生错误的可能原因：</b><br><br>"
	Response.Write Chr(10)
	Response.Write "<li>您是否仔细阅读了<a href="&DEF_BBS_homeUrl&"User/Help/Help.asp>帮助文件</a>，可能您还没有<a href="&DEF_BBS_homeUrl&"user/login.asp><font color=ff2222>登陆</font></a>或者不具有使用当前功能的权限。"
	Response.Write Chr(10)
	Response.Write WPD_errmsg
	Response.Write Chr(10)
	Response.Write "<br><br><br><br>"
	Response.Write Chr(10)
	Response.Write "<a href="&Request.ServerVariables("HTTP_REFERER")&"> << 返回上一页</a>"
	Response.Write Chr(10)
	Response.Write "</td></tr>"
	Response.Write Chr(10)
	Response.Write "</table>"
	Response.Write Chr(10)
	WPD_Footer()
	Response.End		
end sub

sub WPD_suc()
	Response.Write Chr(10)
	Response.Write "<table width="&DEF_BBS_ScreenWidth&" cellspacing=1 cellpadding=3 align=center bgcolor="&DEF_BBS_DarkColor&" class=TBone>"
	Response.Write Chr(10)
	Response.Write "<tr align=center bgcolor="&DEF_BBS_LightDarkColor&">"
	Response.Write Chr(10)
	Response.Write "<td class=TBHead><font color=#ffffff class=HeadFont><b>社区成功信息</b></font></td>"
	Response.Write Chr(10)
	Response.Write "</tr>"
	Response.Write Chr(10)
	Response.Write "<tr bgcolor="&DEF_BBS_LightestColor&" class=TBBG9>"
	Response.Write Chr(10)
	Response.Write "<td>"
	Response.Write Chr(10)
	Response.Write "<b>操作成功：</b><br><br>"
	Response.Write WPD_sucmsg
	Response.Write "</td></tr>"
	Response.Write "<tr bgcolor="&DEF_BBS_LightestColor&" class=TBBG9>"
	Response.Write Chr(10)
	Response.Write "<td>"
	Response.Write Chr(10)
	Response.Write "<a href="&Request.ServerVariables("HTTP_REFERER")&"> << 返回上一页</a>"
	Response.Write "</td></tr>"
	Response.Write Chr(10)
	Response.Write "</table>"
	Response.Write Chr(10)
	WPD_Footer()
	Response.End		
end sub

Function WPD_GetBit(Number,bit)
	Dim BinaryData,BinaryDataNum
	BinaryData = Array(1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,65536,131072,262144,524288,1048576,2097152,4194304,8388608,16777216,33554432,67108864,134217728,268435456,536870912,1073741824,2147483648)
	BinaryDataNum = Ubound(BinaryData,1)

	If bit = BinaryDataNum Then
		If Number = BinaryData(bit) Then
			WPD_GetBit = 1
		Else
			WPD_GetBit = 0
		End If
	Else
		If (Number mod BinaryData(bit)) >= BinaryData(bit-1) Then
			WPD_GetBit = 1
		Else
			WPD_GetBit = 0
		End If
	End if

End Function

Function WPD_isTrueDate(TStr)

	Dim TempDate
	TempDate = TStr
	TempDate = Replace(TempDate,"年","-")
	TempDate = Replace(TempDate,"月","-")
	TempDate = Replace(TempDate,"日"," ")
	TempDate = Replace(TempDate,"上午"," ")
	TempDate = Replace(TempDate,"下午"," ")
	TempDate = Replace(TempDate,"  "," ")
	TempDate = Replace(TempDate,"  "," ")

	Dim N1,N2
	N1 = inStr(TempDate,"-")
	If N1>0 Then N2 = inStrRev(TempDate,"-")
	If N1 = N2 and N1 >0 Then
		WPD_isTrueDate = 0
		Exit Function
	End If

	N1 = inStr(TempDate,":")
	If N1>0 Then N2 = inStrRev(TempDate,"-")
	If N1 = N2 and N1 >0 Then
		WPD_isTrueDate = 0
		Exit Function
	End If

	If isDate(TStr) Then
		WPD_isTrueDate = 1
	Else
		WPD_isTrueDate = 0
	End If

End Function

Function WPD_GetTimeValue(DateString)

	Dim Temp,TempStr
	If isNull(DateString) or isTrueDate(DateString) = 0  Then Exit Function
	Temp = csTr(Year(DateString))
	If len(temp)<3 Then
		Temp = left(year(date),2) & temp
	End If
	TempStr = Temp

	Temp = csTr(month(DateString))
	If len(temp)<2 Then
		Temp = "0" & temp
	End If
	TempStr = TempStr & Temp

	Temp = csTr(day(DateString))
	If len(temp)<2 Then
		Temp = "0" & temp
	End If
	TempStr = TempStr & Temp

	Temp = csTr(Hour(DateString))
	If len(temp)<2 Then
		Temp = "0" & temp
	End If
	TempStr = TempStr & Temp

	Temp = csTr(Minute(DateString))
	If len(temp)<2 Then
		Temp = "0" & temp
	End If
	TempStr = TempStr & Temp

	Temp = csTr(Second(DateString))
	If len(temp)<2 Then
		Temp = "0" & temp
	End If
	TempStr = TempStr & Temp

	WPD_GetTimeValue = cCur(TempStr)

End Function

function WPD_IsValidEmail(email)

	dim names, name, i, c
	IsValidEmail = true
	names = Split(email, "@")
	if UBound(names) <> 1 then
	   WPD_IsValidEmail = false
	   exit function
	end if
	for each name in names
	   if Len(name) <= 0 then
	     WPD_IsValidEmail = false
	     exit function
	   end if
	   for i = 1 to Len(name)
	     c = Lcase(Mid(name, i, 1))
	     if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
	       WPD_IsValidEmail = false
	       exit function
	     end if
	   next
	  if Left(name, 1) = "." or Right(name, 1) = "." then
	     WPD_IsValidEmail = false
	      exit function
	   end if
	next
	if InStr(names(1), ".") <= 0 then
	   WPD_IsValidEmail = false
	   exit function
	end if
	i = Len(names(1)) - InStrRev(names(1), ".")
	if i <> 2 and i <> 3 then
	   WPD_IsValidEmail = false
	   exit function
	end if
	if InStr(email, "..") > 0 then
	   WPD_IsValidEmail = false
	end if
end function
Sub WPD_CheckMysms()
	If WPD_newincept <> 0 then
	response.write "<a href="""&WPD_PlusPath&"SMS/userSMS.asp"" target=_blank>您有<font color=red>新</font>的短消息！</a>"
	End if
End sub
Sub WPD_WriteCenter(wstring)
	response.write "<center>"&wstring&"</center>"
	Response.Write "<br>"
	Response.Write "<center><a href="&Request.ServerVariables("HTTP_REFERER")&"> << 返回上一页</a></center>"
End sub
Sub WPD_WriteBr(wstring)
	response.write wstring&"<br>"
End sub
Function WPD_ShowMyLove(username)
dim rs,sql
sql="select username,wife from [user] where username='"&username&"'"
set rs=conn.execute(sql)
if rs.bof and rs.eof then
	WPD_ShowMyLove="单身贵族"
else
	if trim(rs("wife"))="" or isNull(rs("wife")) then
		WPD_ShowMyLove="<font color=green>单身贵族</font>"
	else
		WPD_ShowMyLove="<font color=red>"&rs("wife")&"</font>"
	end if
end if
set rs=nothing
End function
%>
