本次整合仅说明KesionCMS V2.0/2.1/2.2与动网论坛最新版V7.1 sp1的整合过程，其它系统的整合过程类似。 科汛CMS与被整合的程序(Dvbbs V7.1 Sp1)，可以任何放在不同的域名，甚至不同的服务器下运行.当新用户注册时，数据同时写入KesioncCMS的主数据库与被整合系统的数据库。真正实现用户从任意一个系统进行登陆都可以。用户的基本资料修改操作都转到主系统(KesionCMS)完成，确保用户资料的同步。用户数据之间的传递，采用了私钥认证方式，资料在传递过程前先使用私钥进行加密，在被整合端(Dvbbs)使用私钥进行验证,保正传输过程中数据及网站的安全。
整合步骤:
说明：红色的代码，表示新增加的,绿色部分代表注销。蓝色部分代表应修改
1、KesionCMS 数据库连接文件 conn.asp的修改
Dim SqlNowString,SiteSN,Conn,DBPath,CollectDBPath,DataServer,DataUser,DataBaseName,DataBasePsw
Const DataBaseType=1 '系统数据库类型，"1"为MS SQL2000数据库，"0"为MS ACCESS 2000数据库
Const SysVer=1
Const RefreshTime = 2 '注册、登录、退出整合同步跳转时间。
Const EnableIntegrat = 1 '是否开启整合，如果开启设为1,不开启为0。
Const SecurityKey = "kesioncms" '整合验证私钥,可任意设定
Const ApiUrls = "http://bbs.kesion.com/KS_Passport.asp" '要整合的程序的完整URL（以“http://”开头，以接口文件的文件名结尾），或者是相对于网站根目录的的绝对路径（如“/bbs/KS_Passport.asp”），如果有多个系统要整合，每个URL间用“|”分隔
2、注册提交页面(Register/UserReg_Post.asp)，进行部分修改
Else
ReturnInfo="恭喜您,注册成功!您的用户名:" & UserName & ",您已成为了本站的正式会员!<br><div align=center>【<a href=""../Member/"">会员中心</a>】 【<a href=""/"">返回首页</a>】</div>"
End IF
'发送到相应的整合接口
If EnableIntegrat = 1 Then
Dim KSApi,Num
If IsNull(SecurityKey) = False And SecurityKey <> "" And IsNull(ApiUrls) = False And ApiUrls <> "" Then
KSApi = Split(ApiUrls, "|")
For Num = 0 To UBound(KSApi)
Response.Write "<iframe id='RegisterUser' width='100%' height='0' frameborder='0' src=""" & KSApi(Num) & "?action=RegisterUser&Md5Info=" & KSCMS.MD5(UserName & SecurityKey, 32) & "&name=" & UserName & "&pass=" & KSCMS.MD5(KSCMS.ReplaceBadChar(KSCMS.G("PassWord")), 32) & "&question=" & Question & "&answer=" & Answer & "&Email=" & Email & "&sex=" & Sex & "&lock=0&save=0""></iframe>" & vbCrLf
Next
End If
End If
Response.Cookies(KSCMS.SiteSn)("UserName") = UserName
Response.Cookies(KSCMS.SiteSn)("PassWord") = PassWord
3、登录验证部分(CheckUserlogin.asp)
Verifycode=KSCMS.ReplaceBadChar(KSCMS.G("Verifycode"))
LoginVerificCodeTF=KSCMS.GetConfig("LoginVerificCodeTF")
Dim ComeUrl
ComeUrl= Trim(Request("ComeUrl"))
if ComeUrl="" then
ComeUrl=Trim(Request.ServerVariables("HTTP_REFERER"))
if ComeUrl="" then ComeUrl="User_Index.asp?Action=MyInfo"
end if
ComeUrl=LCase(ComeUrl)
Dim LastLoginIP:LastLoginIP = Trim(Request.ServerVariables("HTTP_X_FORWARDED_FOR"))
If LastLoginIP = "" Then LastLoginIP = Request.ServerVariables("REMOTE_ADDR")
IF UserName="" Then
Response.Write("<script>alert('用户名不能为空，请输入！');history.back();</script>")
Exit Sub
End IF
IF PassWord="" Then
Response.Write("<script>alert('登录密码不能为空，请输入！');history.back();</script>")
Exit Sub
End IF
'IF Trim(Verifycode)<>Trim(Session("Verifycode")) And LoginVerificCodeTF=1 And KSCMS.G("From")<>"Top" then
' Response.Write("<script>alert('验证码有误，请重新输入！');history.back();<//script>")
' Exit Sub
'End IF
If ExpiresDate = "" Or Not IsNumeric(ExpiresDate) Then
ExpiresDate = 0
Else
ExpiresDate = CLng(ExpiresDate)
End If
PassWord=KSCMS.MD5(PassWord,16)
Dim UserRS:Set UserRS=Server.CreateObject("Adodb.RecordSet")
UserRS.Open "Select UserID,UserName,PassWord,Locked,Score,LastLoginIP,LastLoginTime,LoginTimes From KS_User Where UserName='" &UserName & "' And PassWord='" & PassWord & "'",Conn,1,3
If UserRS.Eof And UserRS.BOf Then
Response.Write("<script>alert('你输入的用户名或密码有误，请重新输入！');location.href='" & ComeUrl &"';</script>")
UserRS.Close:Set UserRS=Nothing
Exit Sub
ElseIf UserRS("Locked")=1 Then
Response.Write("<script>alert('您的账号已被管理员锁定，请与管理员联系！');location.href='" & ComeUrl &"';</script>")
Exit Sub
Else
........
.......
Response.Cookies(KSCMS.SiteSn)("UserName") = UserName
Response.Cookies(KSCMS.SiteSn)("Password") = Password
'检查整合部分SecurityKey=KSCMS.G("SecurityKey")
If EnableIntegrat<>1 Then
If InStr(lcase(Request.ServerVariables("HTTP_REFERER")), "login") > 0 Then
Response.Redirect KSCMS.GetDomain & "Member/Index.asp"
else
Response.Redirect Request.ServerVariables("HTTP_REFERER")
end if
Else
Dim KSApi:KSApi = Split(ApiUrls, "|")
Response.Write "<html>" & vbCrLf
Response.Write "<head>" & vbCrLf
Response.Write "<meta http-equiv=""refresh"" content=""" & RefreshTime & ";URL=" & ComeUrl & """ />" & vbCrLf
Response.Write "<title>登陆</title>" & vbCrLf
If SecurityKey <> Empty And IsArray(KSApi) Then
Dim Num
For Num = 0 To UBound(KSApi)
Response.Write "<iframe id='LoginUser' width='100%' height='0' frameborder='0' src='" & LCase(KSApi(Num)) & "?action=LoginUser&Md5Info=" & KSCMS.Md5(UserName & SecurityKey, 32) & "&name=" & UserName & "&pass=" & KSCMS.Md5(KSCMS.ReplaceBadChar(KSCMS.G("PassWord")),32) & "&save=" & KSCMS.ChkClng(KSCMS.G("CookieDate")) & "'></iframe>" & vbCrLf
Next
End If
Response.Write "</head>" & vbCrLf
Response.Write "<body>" & vbCrLf
Response.Write "<span style='font-size:9pt'>正在登陆，请稍等，" & RefreshTime & "秒后返回...</span>" & vbCrLf
Response.Write "</body>" & vbCrLf
Response.Write "</html>" & vbCrLf
End If
End IF
4、注册登录页面（UserLogout.asp),替换为以下即可
<%@language=vbscript codepage=936 %>
<!--#include file="conn.asp"-->
<!--#include file="syscls/KS_CommonCls.asp"-->
<%
Dim KSCMS:Set KSCMS=New CommonCls
Dim ComeUrl:ComeUrl=Trim(request("ComeUrl"))
if ComeUrl="" then ComeUrl=Request.ServerVariables("HTTP_REFERER")
ComeUrl=Lcase(ComeUrl)
if ComeUrl="" or Instr(ComeUrl,"login.asp")>0 or Instr(ComeUrl,"userlogout.asp")>0 then ComeUrl=KSCMS.GetConfig("InstallDir")
If EnableIntegrat=1 Then
Dim KSApi:KSApi = Split(ApiUrls, "|")
Response.Write "<html>" & vbCrLf
Response.Write "<head>" & vbCrLf
Response.Write "<meta http-equiv=""refresh"" content=""" & RefreshTime & ";URL=" & ComeUrl & """ />" & vbCrLf
Response.Write "<title>正在注销中…</title>" & vbCrLf
If SecurityKey <> Empty And IsArray(KSApi) Then
Dim Num
Dim UserName:UserName=Request.Cookies(KSCMS.SiteSn)("UserName")
For Num = 0 To UBound(KSApi)
Response.Write "<iframe id='LogoutUser' width='100%' height='0' frameborder='0' src='" & LCase(KSApi(Num)) & "?action=LogoutUser&Md5Info=" & KSCMS.MD5(UserName & SecurityKey, 32) & "&name=" & UserName & "'></iframe>" & vbCrLf
Next
End If
Response.Write "</head>" & vbCrLf
Response.Write "<body>" & vbCrLf
Response.Write "<div align=center><span style='font-size:9pt'>正在注销，请稍等，" & RefreshTime & "秒后返回...</span></div>" & vbCrLf
Response.Write "</body>" & vbCrLf
Response.Write "</html>" & vbCrLf
Call Delete_KSCookies()
Else
Call Delete_KSCookies()
Response.Redirect KSCMS.GetConfig("InstallDir")
End If
Sub Delete_KSCookies()
Response.Cookies(KSCMS.SiteSn)("UserName") = ""
Response.Cookies(KSCMS.SiteSn)("Password") = ""
session.Abandon()
End Sub
Set KSCMS=Nothing
%>
5.用户资料修改页面 Member/User_EditInfo.asp
RS("Sign")=Sign
RS("Privacy")=Privacy
RS.Update
If EnableIntegrat = 1 Then
Dim KSApi:KSApi = Split(ApiUrls, "|")
Dim Num
If IsNull(SecurityKey) = False And SecurityKey <> "" And IsNull(ApiUrls) = False And ApiUrls <> "" Then
For Num = 0 To UBound(KSApi)
Response.Write "<iframe id='ModifyInfo' width='100%' height='0' frameborder='0' src='" & KSApi(Num) & "?action=ModifyInfo&Md5Info=" & KSCMS.MD5(KSUser.Get_UserName & SecurityKey, 32) & "&name=" & KSUser.Get_UserName & "&pass=" & RS("PassWord") & "&question=" & Question & "&Answer=" &Answer &"&Email=" & Email &"'></iframe>" & vbCrLf
Next
End If
End If
Response.Write "<script>alert('会员资料修改成功！');location.href='index.asp';</script>"
Response.End()
End if
Else
%>
<br />
<table width="745" borde
6.用户密码修改页面 member/User_EditPass.asp
Set RS=Server.CreateObject("Adodb.RecordSet")
RS.Open "Select PassWord From KS_User Where UserName='" & KSUser.Get_UserName & "' And PassWord='" & OldPassWord & "'",Conn,1,3
IF RS.Eof And RS.Bof Then
Response.Write("<script>alert('您输入的旧密码有误！');history.back();</script>")
Response.End
Else
RS(0)=NewPassWord
Response.Cookies(KSCMS.SiteSn)("PassWord") = NewPassWord
RS.Update
If EnableIntegrat = 1 Then
Dim KSApi:KSApi = Split(ApiUrls, "|")
Dim Num
If IsNull(SecurityKey) = False And SecurityKey <> "" And IsNull(ApiUrls) = False And ApiUrls <> "" Then
For Num = 0 To UBound(KSApi)
Response.Write "<iframe id='ModifyInfo' width='100%' height='0' frameborder='0' src='" & KSApi(Num) & "?action=ModifyInfo&Md5Info=" & KSCMS.MD5(KSUser.Get_UserName & SecurityKey, 32) & "&name=" & KSUser.Get_UserName & "&pass=" & KSCMS.MD5(KSCMS.G("ReNewPassWord"), 32) & "'></iframe>" & vbCrLf
Next
End If
End If
End if
%>
<table width="750"
以上步骤基本上完成了科汛主程序的修改．接下来，就是修改动网程序部分,由于整合系统采用私钥进行身份认证．我们就先在动网程序目录inc下，建立一个asp配置文件，名称可以任意取（如：KS_Config.asp）
该文件的作用就是配置与主站点conn.asp里设定的私钥一致及主站点的访问ＵＲＬ等
该文件内容，如下：
<%
Const EnableIntegrat=1 '是否整合主站点，是 1 否 0
Const SecurityKey = "kesioncms" '整合验证私钥，应该与主站点的私钥完全相同。
Const MainSiteURL = "http://www.kesion.com/" '主站的完整URL，以“http://”开头，以“/”结尾，或者是相对路径。（如../,注意以/结尾。）
%>
这个文件，放在动网最新版的Inc目录下
在动网根目录下，创建认证的asp文件，完成注册，修改，注销等操作
假设为取名为:KS_PassPort.asp,代码如下：
<!-- #include file="Conn.asp" -->
<!-- #include file="inc/const.asp" -->
<!-- #include file="inc/chkinput.asp" -->
<!-- #include file="inc/md5.asp" -->
<!--#include file="inc/KS_Config.asp"-->
<%
'完整调用形式：
'<script src="KS_PassPort.asp?action=操作类型&name=用户名&Md5Info=验证串&pass=密码&lock=是否锁定&question=提示问题&answer=答案&email=电子邮件&sex=性别&save=Cookies保存选项"
'action、name、Md5Info是必填参数
'删除用户时不需要其它参数
'更新资料时，提供所要更新的信息即可
'注意：这里传递的用户密码为32位MD5加密
Dim Action,UpiUserName,UpiUserPass,UpiMd5Info,UpiQuestion,UpiAnswer,UpiEmail,UpiUserLock,UpiUserSex,UpiSaveCookies
Dim SiteSecurityMD5
Dim TruePassword
Action = Trim(Request("action"))
UpiUserName = Dvbbs.CheckStr(Trim(Request("name")))
UpiUserPass = Trim(Request("pass"))
If Len(UpiUserPass) = 32 Then UpiUserPass = Mid(UpiUserPass,9,16)
UpiUserPass = Dvbbs.CheckStr(UpiUserPass)
UpiMd5Info = UCase(Trim(Request("Md5Info")))
UpiQuestion = Dvbbs.CheckStr(Trim(Request("question")))
UpiAnswer = Dvbbs.CheckStr(md5(Trim(Request("answer")),16))
UpiEmail = Dvbbs.CheckStr(Trim(Request("email")))
UpiUserSex = Trim(Request("sex"))
UpiUserLock = Trim(Request("lock"))
UpiSaveCookies = Trim(Request("save"))
If Not (Action = "" or UpiUserName = "" or UpiMd5Info = "") Then
Md5OLD = 1
SiteSecurityMD5 = MD5(UpiUserName&SecurityKey,32)
If UpiMd5Info = UCase(SiteSecurityMD5) Then
Select Case Action
Case "RegisterUser"
Call RegisterUser()
Case "LoginUser"
Call LoginUser()
Case "LogoutUser"
Call LogoutUser()
Case "ModifyInfo"
Call ModifyUserInfo()
Case "DelUser"
Call DelUser()
End Select
End If
End If
Sub RegisterUser()
Dvbbs.Stats = "用户注册"
On Error Resume Next
If UpiQuestion = "" Then UpiQuestion = "答案为您的密码"
If UpiAnswer = "" Then UpiAnswer = UpiUserPass
If UpiEmail = "" Then UpiEmail = UpiUserName & "@kesion.com"
If UpiUserSex = "" Then UpiUserSex = 0
If Not IsNumeric(UpiUserSex) Then UpiUserSex = 0
If UpiUserSex < 0 or UpiUserSex > 1 Then UpiUserSex = 0
If UpiUserLock = "" Then UpiUserLock = 0
If Not IsNumeric(UpiUserLock) Then UpiUserLock = 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)
'产生随机密码
Dim TruePassword
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='" & UpiUserName & "'",Conn,1,3
If TempRs.Eof and TempRs.Bof Then
UpiUserExist = False
'插入新记录
TempRs.addnew
TempRs("UserName")=UpiUserName
TempRs("UserPassword")=UpiUserPass
TempRs("UserEmail")=UpiEmail
TempRs("Userclass")=RegClassName
TempRs("TitlePic")=RegTitlePic
TempRs("UserQuesion")=UpiQuestion
TempRs("UserAnswer")=UpiAnswer
TempRs("TruePassWord")=TruePassword
TempRs("UserIM")="||||||||||||||||||"
TempRs("UserPost")=0
TempRs("Usersex")=UpiUserSex
TempRs("Lockuser")=0
If UpiUserLock = 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")=Request.ServerVariables("REMOTE_ADDR")
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(UpiUserName)&"'")
Dvbbs.ReloadSetupCache UpiUserName,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 Not (cint(Dvbbs.Forum_Setting(23))=1 and CInt(Dvbbs.Forum_Setting(25))=1) Then
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 username='"&dvbbs.membername&"' Or id="&StatUserID&"")
Response.Cookies(Dvbbs.Forum_sn)("StatUserID") = StatUserID
Response.Cookies(Dvbbs.Forum_sn)("usercookies") = 0
Response.Cookies(Dvbbs.Forum_sn)("username") = UpiUserName
Response.Cookies(Dvbbs.Forum_sn)("password") = TruePassWord
Response.Cookies(Dvbbs.Forum_sn)("userclass") = RegClassName
Response.Cookies(Dvbbs.Forum_sn)("userid") = Dvbbs.userid
Response.Cookies(Dvbbs.Forum_sn)("userhidden") = 2
Response.Cookies(Dvbbs.Forum_sn).path=Dvbbs.cookiepath
Dvbbs.membername=UpiUserName
Dvbbs.userhidden=2
Dvbbs.MemberClass=RegClassName
End If
session("regtime")=now()
Call LoginUser()
End If
End Sub '注册新用户
Sub LoginUser()
Dim i
If UpiSaveCookies = "" Then UpiSaveCookies=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(UpiUserName, UpiUserPass, "", UpiSaveCookies, 1)
End Sub
Sub LogoutUser()
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 ModifyUserInfo()
On Error Resume Next
Dim tempSQL
tempSQL = "UPDATE Dv_User Set "
If UpiUserPass <> "" and Len(UpiUserPass) = 16 Then
tempSQL = tempSQL & "UserPassWord='" & UpiUserPass & "'"
Else
tempSQL = tempSQL & "UserPassword=UserPassword"
End If
If UpiQuestion <> "" Then
tempSQL = tempSQL & ",UserQuesion='" & UpiQuestion & "'"
End If
If UpiAnswer <> "" and Len(UpiAnswer) = 16 Then
tempSQL = tempSQL & ",UserAnswer='" & UpiAnswer & "'"
End If
If UpiEmail <> "" Then
tempSQL = tempSQL & ",UserEmail='" & UpiEmail & "'"
End If
If UpiUserSex <> "" and IsNumeric(UpiUserSex) Then
If UpiUserSex <0 or UpiUserSex > 1 Then UpiUserSex = 0
tempSQL = tempSQL & ",UserSex=" & UpiUserSex
End If
If UpiUserLock <> "" and IsNumeric(UpiUserLock) Then
If UpiUserLock <0 or UpiUserLock > 1 Then UpiUserLock = 0
tempSQL = tempSQL & ",lockuser=" & UpiUserLock
End If
tempSQL = tempSQL & " WHERE UserName='" & UpiUserName & "'"
Dvbbs.Execute(TempSQL)
End Sub
Sub DelUser()
On Error Resume Next
Dvbbs.Execute("update dv_message set delR=1 where incept='"&trim(UpiUserName)&"' and delR=0")
Dvbbs.Execute("update dv_message set delS=1 where sender='"&trim(UpiUserName)&"' and delS=0 and issend=0")
Dvbbs.Execute("update dv_message set delS=1 where sender='"&trim(UpiUserName)&"' and delS=0 and issend=1")
Dvbbs.Execute("delete from dv_message where incept='"&UpiUserName&"' and delR=1")
Dvbbs.Execute("update dv_message set delS=2 where sender='"&trim(UpiUserName)&"' and delS=1")
Dvbbs.Execute("delete from dv_friend where F_username='"&UpiUserName&"'")
Dvbbs.Execute("delete from dv_bookmark where username='"&UpiUserName&"'")
'删除用户的帖子和精华
Dvbbs.Execute("delete from dv_topic where PostUserName='" & UpiUserName & "'")
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 Num
For Num = 0 to Ubound(AllPostTable)
Dvbbs.Execute("DELETE FROM " & AllPostTable(Num) & " WHERE UserName='" & UpiUserName & "'")
Next
'--------------------替换部分--------------------
Dvbbs.Execute("delete from dv_besttopic where PostUserName='" & UpiUserName & "'")
'删除用户上传表
Dvbbs.Execute("delete from dv_upfile where F_Username='" & UpiUserName & "'")
Dvbbs.Execute("delete from [dv_user] where UserName='" & UpiUserName & "'")
End Sub
' ==========论坛登录函数=========
' 判断用户登录
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
' 判断用户组(等级)资料，当用户级别为跟随文章数增长则自动更新用户组(等级)
' 自动更新用户数据
' 如果属于系统或特殊或多属性组
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&"")
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).path = Dvbbs.cookiepath
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
' 清除图片上传数的限制
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
%>
关键步骤差不多完成了．接下来，再改几个文件即可，注册，注销等的同步
1．动网论坛新用户的注册(reg.asp)
<!--#include file="inc/Email_Cls.asp"-->
<!--#include file="inc/md5.asp"-->
<!--#include file="dv_dpo/cls_dvapi.asp"-->
<!--#include file="inc/KS_Config.asp"-->
<!--#include file="dv_dpo/cls_dvapi.asp"-->
<!--#include file="inc/KS_Config.asp"-->
<%
If EnableIntegrat=1 Then
Dim ComeUrl
ComeUrl = Replace(Lcase(Request.ServerVariables("SCRIPT_NAME")),"reg.asp","")
ComeUrl = "http://" & Lcase(Request.ServerVariables("HTTP_HOST")) & ComeUrl
ComeUrl = ComeUrl & Dvbbs.Forum_Info(11)
Response.Redirect MainSiteURL & "Register/UserReg_Step1.asp?ComeUrl="&ComeUrl
End If
Dim Selectinfo(5)
Dim XMLDom
2. 登录页页(login.asp)
<!--#include file="inc/md5.asp"-->
<!--#include file="dv_dpo/cls_dvapi.asp"-->
<!--#include file="inc/KS_Config.asp"-->
<%
Dim comeurl
Dim TruePassWord
........
Dim mobile
Dim chrs,i
username = Trim(Request("username"))
password = Trim(Request("password"))
usercookies = Trim(Request("CookieDate"))
If ComeUrl <> "" Then
ComeUrl = Replace(Lcase(Request.ServerVariables("SCRIPT_NAME")),"login.asp",ComeUrl)
ComeUrl = "http://" & Lcase(Request.ServerVariables("HTTP_HOST")) & ComeUrl
Else
ComeUrl = Replace(Lcase(Request.ServerVariables("SCRIPT_NAME")),"login.asp","")
ComeUrl = "http://" & Lcase(Request.ServerVariables("HTTP_HOST")) & ComeUrl
ComeUrl = ComeUrl & Dvbbs.Forum_Info(11)
End If
Response.Write "<form name='upiform' id='upiform' action='"&MainSiteURL&"CheckUserLogin.asp' method='post'>" & vbCrLf
Response.Write " <input type='hidden' name='UserName' value='"&username&"'>" & vbCrLf
Response.Write " <input type='hidden' name='Password' value='"&password&"'>" & vbCrLf
Response.Write " <input type='hidden' name='CookieDate' value='"&usercookies&"'>" & vbCrLf
Response.Write " <input type='hidden' name='ComeUrl' value='"&ComeUrl&"'>" & vbCrLf
Response.Write " <input type='hidden' name='SecurityKey' value='"&Md5(UserName & SecurityKey, 32)&"'>" & vbCrLf
Response.Write "</form>" & vbCrLf
Response.Write "<script language='JavaScript' type='text/javascript'>" & vbCrLf
Response.Write " upiform.submit();" & vbCrLf
Response.Write "</script>" & vbCrLf
UserIP=Dvbbs.UserTrueIP
3.注销退出页面(logout.asp)
<!--#include file="dv_dpo/cls_dvapi.asp"-->
<!--#include file="inc/KS_Config.asp"-->
<% .....
.....
response.write"</script>"
If EnableIntegrat=1 Then
Dim ComeUrl:ComeUrl = Request.ServerVariables("HTTP_REFERER")
If Lcase(Left(ComeUrl,4)) <> "http" Then
ComeUrl = Replace(Lcase(Request.ServerVariables("SCRIPT_NAME")),"logout.asp","")
ComeUrl = "http://" & Lcase(Request.ServerVariables("HTTP_HOST")) & ComeUrl
ComeUrl = ComeUrl & Dvbbs.Forum_Info(11)
End If
Response.Redirect MainSiteURL & "UserLogout.asp?UserName=" & Dvbbs.membername & "&ComeUrl="&ComeUrl
End If
4．资料修改页面(modifyadd.asp)
<!--#include file="inc/chkinput.asp"-->
<!--#include file="inc/KS_Config.asp"-->
<%
Dvbbs.LoadTemplates("Usermanager")
.....
Sub Psw_Main()
'转到主站点去修改
Response.Redirect MainSiteURL & "Member/User_EditPass.asp"
If Request("action")="updat" Then
Call Psw_Update()
If ErrCodes<>"" Then Response.redirect "showerr.asp?ErrCodes="&ErrCodes&"&action=OtherErr"
Dvbbs.Showerr()
Dvbbs.Dvbbs_Suc("<li>"+template.Strings(26))
Else
Call Psw_Userinfo()
Dvbbs.Showerr()
End If
End Sub
这样就算完成了，与动网论坛的整合了．效果见 www.kesion.com与http://bbs.kesion.com
完整整合程序，正在整理中,推后发布！
[此贴子已经被作者于2006-7-4 22:10:28编辑过]
当前位置：
支持(0) | 
反对(0)
顶端 
底部
![电子邮件:[ servicess@kesion.com ]](http://bbs.kesion.com/club/images/email.gif){kind=small}
