<!--#include file="Conn.asp" -->
<!--#include file="inc/const.asp" -->
<!--#include file="inc/chan_const.asp"-->
<!--#include file="inc/chkinput.asp" -->
<!--#include file="inc/Upiconfig.asp"-->
<!--#include file="inc/md5.asp" -->
<!--#include file="inc/dv_clsother.asp"-->
<!--#include file="inc/Email_Cls.asp"-->
<%
'******************************************************
'文件名：     DV_Interface.asp
'描　述：     动网8.0&恒浪IMS前台整合接口文件
'版  本：     动网8.0_For HoWave_IMSV5.x&V4.x
'Copyright    2007 HoWave.Net Inc. All Rights Reserved.
'Code Update: SeaShell 
'最后更新:    2007-06-25
'******************************************************
'恒浪IMS接口定义的变量
Dim H_UserName,H_Password,H_Question,H_Answer,H_Email,H_OriginPassword,H_CookieTime,H_Action,H_UserSex,H_SecurityKey,H_Other,H_ComeUrl
'恒浪IMS定义其它变量
Dim H_Password_32,H_CurrentDate,Sys_SecurityKey,H_HowaveLoginType,TrueIP,H_UserLock,TruePassword

'******************************************** 请求数据 **************************************
	H_Action         = Trim(Request("action"))               '---------------------------------当前操作
	H_SecurityKey    = Trim(Request("SecurityKey"))          '---------------------------------密钥
	H_UserName       = Trim(Request("username"))             '---------------------------------用户名
	H_Password       = Trim(Request("password"))             '---------------------------------密码
	H_Password_32    = H_Password                            '---------------------------------32位加密(小写)
	H_Question       = Trim(Request("question"))             '---------------------------------问题
	H_Answer         = Trim(Request("answer"))               '---------------------------------答案
	H_Email          = Trim(Request("email"))                '---------------------------------邮箱
	H_UserSex        = Trim(Request("sex"))                  '---------------------------------性别
	H_CookieTime     = Trim(Request("cookietime"))           '---------------------------------登录Cookies保存时间
	H_OriginPassword = Trim(Request("OriginPass"))           '---------------------------------修改密码时验证的密码
	H_CurrentDate    = Year(Now) & Right("0" & Month(now),2) & Right("0" & Day(now),2) & Right("0" & Hour(now),2)   '-----当前日期
	H_Other          = Trim(Request("Other"))                '---------------------------------保留参数
	H_HowaveLoginType= Trim(Request("howaveLoginType"))      '---------------------------------异步登录
	H_UserLock       = Trim(Request("lock"))                 '---------------------------------用户状态
	TrueIP = Trim(Request.ServerVariables("HTTP_X_FORWARDED_FOR")) '---------------------------IP地址
	
    
	If TrueIP = "" Then TrueIP = Request.ServerVariables("REMOTE_ADDR")
	If Len(H_Password) = 32 Then H_Password = Mid(H_Password,9,16) 
	If Len(H_Answer) = 32 Then H_Answer = Mid(H_Answer,9,16) 
	If Len(H_OriginPassword) = 32 Then H_OriginPassword = Mid(H_OriginPassword,9,16) 
'******************************************** 请求数据 **************************************

'********************************* 收到退出命令后执行退出子程序 *****************************
	If H_Action="Logout" Then 
	   Call Logout()
	   Call CrossDomain()
	End IF
'********************************* 收到退出命令后执行退出子程序 *****************************

'***************************************** 命令选择执行 *************************************
    If Not (H_Action = "" Or H_UserName = "" Or H_SecurityKey = "") And HLIntegration = True Then
		'校验码采用的是URLEncode后的用户名(小写)+用户密码+密钥+H_Action+YYYYMMDDHH，采用32位加密的形式
		Sys_SecurityKey = MD5(Lcase(Server.URLEncode(H_UserName)) & H_Password_32 & SecurityKey & H_Action & H_CurrentDate,32)
		If Ucase(H_SecurityKey) <> Ucase(Sys_SecurityKey) Then
		    Response.Write("签名不正确，请返回来源页登录")
			Response.End()
		End If 
		
		Select Case H_Action
			Case "Reg"
				Call Reg()
				Call Login()
				Call CrossDomain()
			Case "Login"
				Call Login()
				Call CrossDomain()
			Case "Modify"
				Call Modify()
				Call CrossDomain()
			Case "Delete"
				Call Del()
			Case "Test"
			    Call TestInterface()
		End Select
	End If 
'***************************************** 命令选择执行 *************************************

'**************************************** 跨域名接口组装 **************************************
	Sub CrossDomain()'跨域名的接口组装
		Dim NextInterfaceArray,splitflag,NextInterface,NextCrossDominUrl,NextInterfaceUrl,i,CrossUrlNums,ComeUrl,CrossUrlArray
		If(Request("CrossDomain")="true") then
			ComeUrl=Request("ComeUrl")
			CrossUrlArray=Trim(Request("CrossUrlArray")) '取出下一个跨域名的网站接口地址	
			if CrossUrlArray<>"" then
			   NextInterfaceUrl=GetUrl()'获取当前的接口地址
			   splitflag=instr(NextInterfaceUrl,"?")
			   NextInterface=Right(NextInterfaceUrl,(Len(NextInterfaceUrl)-splitflag+1)) 	
			   if instr(CrossUrlArray,",")>0 then
				  NextInterfaceArray =split(CrossUrlArray,",")
				  CrossUrlNums=UBound(NextInterfaceArray)
				  For i = 1 To CrossUrlNums
					 NextCrossDominUrl=NextCrossDominUrl&NextInterfaceArray(i)&","
				  Next		
				  NextCrossDominUrl=Left(NextCrossDominUrl,(len(NextCrossDominUrl)-1))
				  NextInterfaceUrl=NextInterfaceArray(0)&NextInterface		  
			   else
				  NextCrossDominUrl=""
				  NextInterfaceUrl=CrossUrlArray&NextInterface
			   end if
			   splitflag=InstrRev(NextInterfaceUrl,"=")		  
			   NextInterfaceUrl=Left(NextInterfaceUrl,splitflag)&NextCrossDominUrl	
			Else
			   NextInterfaceUrl=ComeUrl   
			end if
			if NextInterfaceUrl<>"" then
			   Response.Redirect NextInterfaceUrl
			Else
			   Response.Redirect "index.asp"
			End If 
		End If
		If H_HowaveLoginType="1" Then Response.Redirect("Index.asp")	
	End Sub
'**************************************** 跨域名接口组装 **************************************

'***************************************** 执行注册代码 *************************************
Sub Reg()
	Dvbbs.Stats = "用户注册"
	On Error Resume Next

	If H_UserLock = "" Then H_UserLock = 0
	If Not IsNumeric(H_UserLock) Then H_UserLock = 0
	Dim UpiUserExist
	UpiUserExist = True
	
	Dvbbs.LoadTemplates("login")
	'通行注册要产生的字段
	Dim RegUserFace,RegTitlePic,RegClassName
	'随机产生用户头像
	Dim ForumAllFace,FaceTotalNum,RegUserFaceNum
	ForumAllFace = Split(Dvbbs.Forum_userface,"|||")
	FaceTotalNum = Ubound(ForumAllFace)-1
	Randomize
	RegUserFaceNum = Int(Rnd * FaceTotalNum)
	RegUserFace = ForumAllFace(0)&ForumAllFace(RegUserFaceNum)
	'产生随机密码
	
	TruePassword = Dvbbs.Createpass
	'判断用户所属用户组
	Dim TempRs
	Set TempRs = Dvbbs.Execute("Select UserTitle,GroupPic,UserGroupID,IsSetting,ParentGID From Dv_UserGroups Where ParentGID=3 Order By MinArticle")
	RegTitlePic=TempRs(1)
	RegClassName=TempRs(0)
	Dvbbs.UserGroupID = TempRs(2)
	TempRs.Close
	Set TempRs = Nothing
	Set TempRs = Server.CreateObject("Adodb.Recordset")
	TempRs.Open "SELECT * FROM Dv_User WHERE UserName='" & H_UserName & "'",Conn,1,3
	If TempRs.Eof and TempRs.Bof Then
		UpiUserExist = False
		'插入新记录
		TempRs.addnew
		TempRs("UserName")=H_UserName
		TempRs("UserPassword")=H_Password
		TempRs("UserEmail")=H_Email
		TempRs("Userclass")=RegClassName
		TempRs("TitlePic")=RegTitlePic
		TempRs("UserQuesion")=H_Question
		TempRs("UserAnswer")=H_Answer
		TempRs("TruePassWord")=TruePassword
		TempRs("UserIM")="||||||||||||||||||"
		TempRs("UserPost")=0
		TempRs("Usersex")=H_UserSex
		TempRs("Lockuser")=0
		If H_UserLock = 1 Then
			TempRs("UserGroupID")=5
		Else
			TempRs("UserGroupID")=Dvbbs.UserGroupID
		End If
		TempRs("JoinDate")=NOW()
		TempRs("UserFace")=RegUserFace
		TempRs("UserWidth")=32
		TempRs("Usertoday")="0|0|0|0|0"
		TempRs("UserHeight")=32
		TempRs("UserLogins")=1
		TempRs("LastLogin")=NOW()
		TempRs("userWealth")=dvbbs.Forum_user(0)
		TempRs("userEP")=dvbbs.Forum_user(5)
		TempRs("usercP")=dvbbs.Forum_user(10)
		TempRs("UserInfo")="||||||||||||||||||||||||||||||||||||||||||"
		TempRs("Usersetting")="||||||1"
		TempRs("UserPower")=0
		TempRs("UserDel")=0
		TempRs("UserIsbest")=0
		TempRs("UserFav")="陌生人,我的好友,黑名单"
		TempRs("IsChallenge")=0
		TempRs("UserHidden")=0
		TempRs("UserLastIP")=TrueIP
		'TempRs("UserMsg")="0||0||null"
		TempRs.update
	End If
	TempRs.close
	
	If Not UpiUserExist Then
		Dvbbs.execute("UpDate Dv_Setup Set Forum_UserNum=Forum_UserNum+1,Forum_lastUser='"&Dvbbs.HtmlEncode(H_UserName)&"'")
		Dvbbs.ReloadSetupCache H_UserName,14
		Dvbbs.ReloadSetupCache (CLng(Dvbbs.CacheData(10,0))+1),10 
		Set TempRs=Dvbbs.execute("select top 1 userid from [Dv_user] order by userid desc")
			Dvbbs.userid=rs(0)
		TempRs.close
		
		Set TempRs=nothing
		If Dvbbs.Forum_Setting(23) = 1 Then Dvbbs.Forum_Setting(47) = 1 'EMAIL通知密码当然要发邮件 2005-11-9 Dv.Yz
		If Dvbbs.Forum_Setting(47)=1 and Cint(Dvbbs.Forum_Setting(2))>0 Then
			'on error resume next
			'发送注册邮件
			Dim getpass
			topic=Replace(template.Strings(35),"{$Forumname}",Dvbbs.Forum_Info(0))
			If Cint(Dvbbs.Forum_Setting(23))=1 Then
				getpass=rndnum
			Else
				getpass=Request.form("psw"&fname)
			End If
			mailbody = template.html(17)
			mailbody = Replace(mailbody,"{$username}",Dvbbs.HtmlEncode(username))
			mailbody = Replace(mailbody,"{$password}",getpass)
			mailbody = Replace(mailbody,"{$copyright}",Dvbbs.Forum_Copyright)
			mailbody = Replace(mailbody,"{$version}",Dvbbs.Forum_Version)
			Dim DvEmail
			Set DvEmail = New Dv_SendMail
			DvEmail.SendObject = Cint(Dvbbs.Forum_Setting(2))	'设置选取组件 1=Jmail,2=Cdonts,3=Aspemail
			DvEmail.ServerLoginName = Dvbbs.Forum_info(12)	'您的邮件服务器登录名
			DvEmail.ServerLoginPass = Dvbbs.Forum_info(13)	'登录密码
			DvEmail.SendSMTP = Dvbbs.Forum_info(4)			'SMTP地址
			DvEmail.SendFromEmail = Dvbbs.Forum_info(5)		'发送来源地址
			DvEmail.SendFromName = Dvbbs.Forum_info(0)		'发送人信息
			If DvEmail.ErrCode = 0 Then
				DvEmail.SendMail useremail,topic,mailbody	'执行发送邮件
				If DvEmail.Count>0 Then
					If Cint(Dvbbs.Forum_Setting(23))=1 Then
						sendmsg=template.Strings(38)
					Else
						sendmsg=template.Strings(39)
					End If
				Else
					sendmsg=template.Strings(37)
				End If
			Else
				sendmsg=template.Strings(37)
			End If
			Set DvEmail = Nothing
		Else
			sendmsg = template.Strings(36)
		End If    
	
		If Dvbbs.Forum_Setting(46)="1" Then
			'发送注册短信
			Dim sender,title,body,UserMsg,MsgID,sqlstr,rs,sqlstr2
			sender=Dvbbs.Forum_Info(0)
			title=Dvbbs.lanstr(2)&Dvbbs.Forum_Info(0)
			body = template.html(18)
			body = Replace(body,"{$Forumname}",Dvbbs.Forum_Info(0))
			sqlstr="insert into dv_message(incept,sender,title,content,sendtime,flag,issend) values('"&H_UserName&"','"&sender&"','"&title&"','"&body&"','"&NOW()&"',0,1)"
		
			Dvbbs.Execute(sqlstr)
			Set rs=Dvbbs.execute("select top 1 ID from [Dv_message] order by ID desc")
			MsgID=rs(0)
			Rs.close:Set Rs=Nothing
			UserMsg="1||"& MsgID &"||"& sender	
			sqlstr2="UPDATE [Dv_User] Set UserMsg='"&Dvbbs.CheckStr(UserMsg)&"' WHERE UserName='"&Dvbbs.CheckStr(H_UserName)&"'"
			Dvbbs.Execute(sqlstr2)		
		End If
		Call Login()
	End If
End Sub 
'***************************************** 执行注册代码 *************************************

'***************************************** 执行登录代码 *************************************
Sub Login()
    If Request.Cookies(Dvbbs.Forum_sn)("UserName")<>"" And Request.Cookies(Dvbbs.Forum_sn)("userid")<>"" And Request.Cookies(Dvbbs.Forum_sn)("password")<>"" Then
	    If H_HowaveLoginType="1" Then
		    Response.Redirect("index.asp")
			Exit Sub
		Else
		    Exit Sub
		End If
	End If
	Dim i
	If H_CookieTime = "" Then H_CookieTime=0
	'产生随机密码
	TruePassword = Dvbbs.Createpass
	
	'判断更新cookies目录
	Dim cookies_path_s,cookies_path_d,cookies_path
	cookies_path_s=split(Request.ServerVariables("PATH_INFO"),"/")
	cookies_path_d=ubound(cookies_path_s)
	cookies_path="/"
	For i=1 to cookies_path_d-1
		If not (cookies_path_s(i)="upload" or cookies_path_s(i)="admin") Then cookies_path=cookies_path&cookies_path_s(i)&"/"
	Next
	If dvbbs.cookiepath<>cookies_path Then
		cookies_path=replace(cookies_path,"'","")
		Dvbbs.execute("update dv_setup set Forum_Cookiespath='"&cookies_path&"'")
		Dim setupData 
		Dvbbs.CacheData(26,0)=cookies_path
		Dvbbs.Name="setup"
		Dvbbs.value=Dvbbs.CacheData
	End If
	'判断用户是否登录
    Call ChkUserLogin(H_UserName, H_Password, "", H_CookieTime, 1)
	If H_HowaveLoginType="1" Then
	    Response.Redirect("Index.asp")
	End If
End Sub
'***************************************** 执行登录代码 *************************************

'***************************************** 执行退出代码 *************************************
Sub Logout()
	If Not IsObject(Conn) Then ConnectionDatabase
	Dim activeuser,TempNum
	If Not CLng(DVbbs.UserSession.documentElement.selectSingleNode("userinfo/@userid").text)=0 Then
		activeuser="delete from Dv_online where userid= "& DVbbs.UserSession.documentElement.selectSingleNode("userinfo/@userid").text
		Conn.Execute activeuser,TempNum
		'更新缓存总用户在线数据
		MyBoardOnline.Forum_UserOnline = MyBoardOnline.Forum_UserOnline - TempNum
		Dvbbs.Name="Forum_UserOnline"
		Dvbbs.value=MyBoardOnline.Forum_UserOnline
	Else
		If IsNumeric(DVbbs.UserSession.documentElement.selectSingleNode("userinfo/@statuserid").text) Then 
			activeuser="delete from Dv_online where id="& DVbbs.UserSession.documentElement.selectSingleNode("userinfo/@statuserid").text
			Conn.Execute activeuser,TempNum
			'更新缓存总用户在线数据
			MyBoardOnline.Forum_GuestOnline = MyBoardOnline.Forum_GuestOnline - TempNum
			Dvbbs.Name="Forum_GuestOnline"
			Dvbbs.value=MyBoardOnline.Forum_GuestOnline
		End If 
	End If
	MyBoardOnline.Forum_Online = MyBoardOnline.Forum_Online - TempNum
	Dvbbs.Name="Forum_Online"
	Dvbbs.value=MyBoardOnline.Forum_Online
	Response.Cookies(Dvbbs.Forum_sn).path=Dvbbs.cookiepath
	Response.Cookies(Dvbbs.Forum_sn)("username")=""
	Response.Cookies(Dvbbs.Forum_sn)("password")=""
	Response.Cookies(Dvbbs.Forum_sn)("userclass")=""
	Response.Cookies(Dvbbs.Forum_sn)("userid")=""
	Response.Cookies(Dvbbs.Forum_sn)("userhidden")=""
	Response.Cookies(Dvbbs.Forum_sn)("usercookies")=""
	If EnabledSession Then	
		Session(Dvbbs.CacheName & "UserID")=Empty
	End If
	Set Dvbbs.UserSession=Nothing 
	Session("flag")=Empty
End Sub
'***************************************** 执行登录代码 *************************************


'***************************************** 执行修改通行证代码 *************************************
Sub Modify()
Dim DB_Table,UserNameItem,PasswordItem,QuestionItem,AnswerItem,EmailItem,UserSexItem,tempSQL
DB_Table = "Dv_User"
UserNameItem = "UserName"
PasswordItem = "UserPassword"
QuestionItem = "UserQuesion"
AnswerItem = "UserAnswer"
EmailItem = "UserEmail"
UserSexItem = "Usersex"
    tempSQL = "Update "& DB_Table &" Set "
	If H_Password<>"" Then
	    If PasswordItem<>"" Then
		    tempSQL = tempSQL & PasswordItem &"='"& H_Password &"'"
		End If
	Else
		If PasswordItem<>"" Then
		    tempSQL = tempSQL & PasswordItem &"="& PasswordItem &""
		End If
	End If
	If H_Answer<>"" Then
	    If AnswerItem<>"" Then
	        tempSQL = tempSQL &", "& AnswerItem &"='"& H_Answer &"'"
		End If
	End If
	If H_Question<>"" Then
	    If QuestionItem<>"" Then
		    tempSQL = tempSQL &", "& QuestionItem &"='"& H_Question &"'"
		End If
	End If
	If H_Email<>"" Then
	    If EmailItem<>"" Then
	        tempSQL = tempSQL &", "& EmailItem &"='"& H_Email &"'"
		End If
	End If
	If H_UserSex<>"" Then
	    If UserSexItem<>"" Then
		    tempSQL = tempSQL &", "& UserSexItem &"='"& H_UserSex &"'"
		End If
	End If
	tempSQL = tempSQL &" Where "& UserNameItem &"='"& H_UserName &"'"
    Dvbbs.Execute(tempSQL)
End Sub
'***************************************** 执行修改通行证代码 *************************************

'***************************************** 执行删除代码 *************************************
Sub Del()
Dim DleoneName,j,DelName
DleoneName = Split(H_UserName, ",")
For j = 0 To UBound(DleoneName)
DelName=Trim(DleoneName(j))
    On Error Resume Next
    Dvbbs.Execute("update dv_message set delR=1 where incept='"&trim(DelName)&"' and delR=0")
    Dvbbs.Execute("update dv_message set delS=1 where sender='"&trim(DelName)&"' and delS=0 and issend=0")
    Dvbbs.Execute("update dv_message set delS=1 where sender='"&trim(DelName)&"' and delS=0 and issend=1")
    Dvbbs.Execute("delete from dv_message where incept='"&DelName&"' and delR=1") 
    Dvbbs.Execute("update dv_message set delS=2 where sender='"&trim(DelName)&"' and delS=1")
    Dvbbs.Execute("delete from dv_friend where F_username='"&DelName&"'") 
    Dvbbs.Execute("delete from dv_bookmark where username='"&DelName&"'") 

    '删除用户的帖子和精华
    Dvbbs.Execute("delete from dv_topic where PostUserName='" & DelName & "'")
	'--------------------替换部分--------------------
    'for i=0 to ubound(allposttable)
    '    Dvbbs.Execute("delete from "&allposttable(i)&" where PostUserID in ("&replace(request("userid"),"'","")&")")
    'next
	'--------------------替换部分--------------------
	Dim AllPostTable
    Dim Trs
    Set Trs=Dvbbs.Execute("select * from [Dv_TableList]")
    AllPostTable=""
    Do While Not TRs.EOF
        If AllPostTable=""  Then 
            AllPostTable=TRs("TableName")
        Else
            AllPostTable=AllPostTable&"|"&TRs("TableName")
        End If
    TRs.MoveNext
    Loop 
    Trs.Close
    AllPostTable=Split(AllPostTable,"|")
    Dim iNum
    For iNum = 0 to Ubound(AllPostTable)
        Dvbbs.Execute("DELETE FROM " & AllPostTable(iNum) & " WHERE UserName='" & DelName & "'")
    Next
	'--------------------替换部分--------------------
    Dvbbs.Execute("delete from dv_besttopic where PostUserName='" & DelName & "'")
    '删除用户上传表
    Dvbbs.Execute("delete from dv_upfile where F_Username='" & DelName & "'")
    Dvbbs.Execute("delete from [dv_user] where UserName='" & DelName & "'")
Next
End Sub
'***************************************** 执行删除代码 *************************************

Rem ==========论坛登录函数=========
Rem 判断用户登录
Function ChkUserLogin(username,password,mobile,usercookies,ctype)

	Dim rsUser,article,userclass,titlepic
	Dim userhidden,lastip,UserLastLogin
	Dim GroupID,ClassSql,FoundGrade
	Dim regname,iMyUserInfo
	Dim sql,sqlstr,OLDuserhidden

	FoundGrade=False
	lastip=Dvbbs.UserTrueIP
	userhidden=request.form("userhidden")
	If userhidden <> "1" Then userhidden=2
	ChkUserLogin=false
	If mobile<>"" Then
		sqlstr=" Passport='"&mobile&"'"
	Else
		sqlstr=" UserName='"&username&"'"
	End If
	Sql="Select UserID,UserName,UserPassword,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin,lastlogin as cometime , LastLogin as activetime,UserLogins,Lockuser,Userclass,UserGroupID,UserGroup,userWealth,userEP,userCP,UserPower,UserBirthday,UserLastIP,UserDel,UserIsBest,UserHidden,UserMsg,IsChallenge,UserMobile,TitlePic,UserTitle,TruePassWord,UserToday,UserMoney,UserTicket,FollowMsgID,Vip_StarTime,Vip_EndTime,userid as boardid"
	Sql=Sql & " From [Dv_User] Where "&sqlstr&""
	set rsUser=Dvbbs.Execute(sql)
	If rsUser.eof and rsUser.bof Then
		ChkUserLogin=False
		Exit Function
	Else
		If rsUser("Lockuser") =1 Or rsUser("UserGroupID") =5 Then
			ChkUserLogin=False
			Exit Function
		Else
			If Trim(password)=Trim(rsUser("UserPassword")) Then
				ChkUserLogin=True
				Dvbbs.UserID=RsUser("UserID")
				RegName = RsUser("UserName")
				Article= RsUser("UserPost")
				UserLastLogin = RsUser("cometime")
				UserClass = RsUser("Userclass")		
				GroupID = RsUser("userGroupID")
				OLDuserhidden=RsUser("UserHidden")
				TitlePic = RsUser("UserTitle")
				If Article < 0  Then Article=0
				Set Dvbbs.UserSession=Dvbbs.RecordsetToxml(rsUser,"userinfo","xml")
				Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@cometime").text=Now()
				Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@activetime").text=DateAdd("s",-3600,Now())
				Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@boardid").text=0
				Dvbbs.UserSession.documentElement.selectSingleNode("userinfo").attributes.setNamedItem(Dvbbs.UserSession.createNode(2,"isuserpermissionall","")).text=Dvbbs.FoundUserPermission_All()
				If OLDuserhidden <> CLng(userhidden) Then
					Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userhidden").text=userhidden
					Dvbbs.Execute("update Dv_user set userhidden="&userhidden&" where UserId=" & Dvbbs.UserID)
				End If
				Dim BS
				Set Bs=Dvbbs.GetBrowser()
				Dvbbs.UserSession.documentElement.appendChild(Bs.documentElement)
				If EnabledSession Then 	Session(Dvbbs.CacheName & "UserID")=Dvbbs.UserSession.xml
			Else
				ChkUserLogin=False
				Exit Function
			End If
		End If
	End If
	If ChkUserLogin Then
	REM 判断用户组(等级)资料，当用户级别为跟随文章数增长则自动更新用户组(等级)
	REM 自动更新用户数据
	REM 如果属于系统或特殊或多属性组
	Set rsUser=Dvbbs.Execute("Select MinArticle,IsSetting,ParentGID,UserTitle,GroupPic From Dv_UserGroups Where UserGroupID="&GroupID)
	If Not (rsUser.Eof And rsUser.Bof) Then
		If rsUser(2)=1 Or rsUser(2)=2 Or rsUser(2)=4 Or rsUser(2)=5 Then
			'用户等级不按照文章升级，用户为系统或特殊或多属性组
			UserClass=rsUser(3)
			TitlePic=rsUser(4)
			FoundGrade=True
		End If
	End If
	If Not FoundGrade Then
		'如果不属于系统或特殊或多属性组,则将该用户属于注册用户组且按照其文章数自动更新其用户组(等级)
		Set rsUser=Dvbbs.Execute("Select Top 1 usertitle,GroupPic,UserGroupID From Dv_UserGroups Where ParentGID=3 And Minarticle<="&Article&" Order By MinArticle Desc,UserGroupID")
		If Not (rsUser.Eof And rsUser.Bof) Then
			UserClass=rsUser(0)
			TitlePic=rsUser(1)
			GroupID=rsUser(2)
			FoundGrade=True
		End If
	End If
	Set rsUser=nothing
	If Not FoundGrade Then Response.Redirect "showerr.asp?ErrCodes=<li>系统没有找到您的注册用户组资料，请联系管理员进行修正。&action=OtherErr"
	select case ctype
	case 1
		If Datediff("d",UserLastLogin,Now())=0 Then
			sql="update [Dv_User] set LastLogin="&SqlNowString&",UserLogins=UserLogins+1,UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
		Else
			sql="update [Dv_User] set userWealth=userWealth+"&Dvbbs.Forum_user(4)&",userEP=userEP+"&Dvbbs.Forum_user(9)&",userCP=userCP+"&Dvbbs.Forum_user(14)&",LastLogin="&SqlNowString&",UserLogins=UserLogins+1,UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
		End If
	case 2
		sql="update [Dv_User] set UserPost=UserPost+1,UserTopic=UserTopic+1,userWealth=userWealth+"&Dvbbs.Forum_user(1)&",userEP=userEP+"&Dvbbs.Forum_user(6)&",userCP=userCP+"&Dvbbs.Forum_user(11)&",LastLogin="&SqlNowString&",UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
	case 3
		sql="update [Dv_User] set UserPost=UserPost+1,userWealth=userWealth+"&Dvbbs.Forum_user(2)&",userEP=userEP+"&Dvbbs.Forum_user(7)&",userCP=userCP+"&Dvbbs.Forum_user(12)&",LastLogin="&SqlNowString&",UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
	end select
	Dvbbs.Execute(sql)
	Dim StatUserID,UserSessionID
		StatUserID = Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("StatUserID")))
		If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
			StatUserID = Replace(Dvbbs.UserTrueIP,".","")
			UserSessionID = Replace(Startime,".","")
			If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
			StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
		End If
	StatUserID = Ccur(StatUserID)
	Dvbbs.Execute("delete from dv_online where  id="&StatUserID&"")
	Response.Cookies(Dvbbs.Forum_sn).path = Dvbbs.cookiepath
	If trim(username)<>trim(Dvbbs.membername) Then
		Response.Cookies(Dvbbs.Forum_sn)("username")=""
		Response.Cookies(Dvbbs.Forum_sn)("password")=""
		Response.Cookies(Dvbbs.Forum_sn)("userclass")=""
		Response.Cookies(Dvbbs.Forum_sn)("userid")=""
		Response.Cookies(Dvbbs.Forum_sn)("userhidden")=""
		Response.Cookies(Dvbbs.Forum_sn)("usercookies")=""
		Dvbbs.Execute("delete from dv_online where username='"&Dvbbs.membername&"'")
	End If
	If isnull(usercookies) or usercookies="" Then usercookies="0"

	Select case usercookies
	case "0"
		Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
	case 1
   		Response.Cookies(Dvbbs.Forum_sn).Expires=Date+1
		Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
	case 2
		Response.Cookies(Dvbbs.Forum_sn).Expires=Date+31
		Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
	case 3
		Response.Cookies(Dvbbs.Forum_sn).Expires=Date+365
		Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
	End Select
	Response.Cookies(Dvbbs.Forum_sn)("username") = regname
	Response.Cookies(Dvbbs.Forum_sn)("userid") = Dvbbs.UserID
	Response.Cookies(Dvbbs.Forum_sn)("password") = TruePassWord
	Response.Cookies(Dvbbs.Forum_sn)("userclass") = userclass
	Response.Cookies(Dvbbs.Forum_sn)("userhidden") = userhidden

	rem 清除图片上传数的限制
	Response.Cookies("upNum")=0
	Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@truepassword").text= TruePassWord
	Dvbbs.Membername=Dvbbs.Checkstr(regname)
	Dvbbs.Memberclass=Dvbbs.Checkstr(userclass)
	Dvbbs.UserGroupID=GroupID
	End If
End Function


'//接口测试
Sub TestInterface()
    Dim ConfigStr
	ConfigStr="<div style='font-size:13px'>"&vbcrlf
    ConfigStr=ConfigStr&"接口正常!</br>接口配置文件UpiConfig.asp设置参数如下："&vbcrlf
	ConfigStr=ConfigStr&"<ul>"  
	if HLVer="1" Then 	   
	   ConfigStr=ConfigStr&"<li>你现在使用的接口模式为IMSV5.x"
	   if HLIsSQL="0" then
	      ConfigStr=ConfigStr&"Access版本</li>"
	   else
	      ConfigStr=ConfigStr&"SQL版本</li>"
	   end if	   
	else 
	   ConfigStr=ConfigStr&"<li>接口模式为IMSV4.x</li>"
	end if
	ConfigStr=ConfigStr&"<li>IMS所在站点URL为:"&HL_Url&"</li><li>前台密钥SecurityKey与IMS后台设置一致</li>"
	if RegPageSet="" then
	   ConfigStr=ConfigStr&"<li>注册模式为：原系统注册</li>"
	else
	   ConfigStr=ConfigStr&"<li>注册模式为：跳转到"&RegPageSet&"进行注册</li>"
	end if
	if Domainname="" then 
	   ConfigStr=ConfigStr&"<li>设置子域名为:空</li>"
	else
	   ConfigStr=ConfigStr&"<li>设置子域名为:"& Domainname&"</li>"
	end if
	ConfigStr=ConfigStr&"</div>"
	Response.Write ConfigStr
	Response.End()
End Sub

'**************************************************
'函数名：ReplaceBadChar
'作  用：过滤非法的SQL字符
'参  数：strChar-----要过滤的字符
'返回值：过滤后的字符
'**************************************************
Function ReplaceBadChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceBadChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "',^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ""
    arrBadChar = Split(strBadChar, ",")
    tempChar = strChar
    For i = 0 To UBound(arrBadChar)
        tempChar = Replace(tempChar, arrBadChar(i), "")
    Next
    ReplaceBadChar = tempChar
End Function

'**************************************************
'函数名：GetUrl
'作  用：获取当前页面URL
'返回值：当前页面URL
'日  期：2007-1-31 By Howave&Jackie
'**************************************************
Function GetUrl() 
    On Error Resume Next 
    Dim strTemp 
    If LCase(Request.ServerVariables("HTTPS")) = "off" Then 
         strTemp = "http://"
    Else 
         strTemp = "https://"
    End If 
    strTemp = strTemp & Request.ServerVariables("SERVER_NAME") 
    If Request.ServerVariables("SERVER_PORT") <> 80 Then 
         strTemp = strTemp & ":" & Request.ServerVariables("SERVER_PORT") 
    end if
        strTemp = strTemp & Request.ServerVariables("URL") 
    If Trim(Request.QueryString) <> "" Then 
        strTemp = strTemp & "?" & Trim(Request.QueryString) 
    end if
    GetUrl = strTemp 
End Function

'=======请保留以下版权说明======
'┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
'┃ 恒浪网站整合系统 HoWaveIMS                                                 ┃
'┃ 版权所有: 恒浪网络(HoWave.Net) / 恒浪网络科技有限公司                      ┃
'┃ 官方论坛: http://bbs.jsp163.com                                            ┃
'┃ 技术支持：(020)88553013 /88386767                                          ┃
'┃ Q  Q: 18469685, 615939753    传真:020-87512750转8                          ┃
'┃ Copyright (C) 2005 HoWave.net All Rights Reserved.                         ┃
'┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
'Copyright (C) 2005 HoWave.net All Rights Reserved.
%>