在网上参考了很多资料后，终于完美实现了网站和discuz!nt论坛的双向整合，整合后网站和论坛之间可以同步注册、登录、退出和修改登录密码操作。
本系统的实现形式是新云CMS网站（ASP）和Discuz!NT3.1论坛（ASP.NET）的同步，使用的API（应用程序编程接口）是新云CMS提供的api（做较大修改）和Discuz!NT提供的API（不做修改）。API使用REST形式的接口，这就意味着Discuz!NT API方法可以用HTTP GET 或 POST方式来调用，几乎每一种计算机语言都可以通过HTTP来与REST服务器进行通讯，REST Server的地址是 [论坛地址/services/restserver.aspx]。
如果主网站是ASP.NET做的，参考本文方法也能轻松实现ASP.NET网站和Discuz!NT论坛的同步。
第一节 从网站同步到论坛的实现
主要功能：
用户在网站注册会员、登录、注销或修改登录密码后，将相关数据以HTTP方式传递到论坛API中，然后论坛执行相应的操作与网站同步（反过来的操作在第二节）。
实现步骤：
一、在论坛后台“扩展”项的“通行证设置”中添加整合程序设置，可参考http://nt.discuz.net/showtopic-62656.html。
二、在论坛后台“全局”项的“基本设置”-“身份验证Cookie域”中设置域名。
三、添加实现同步的代码。
md5_utf8文件：md5的UTF-8版本加密函数，这个网上很多，注意生成的是32为的MD5密码
RestClient.asp文件：
<!-- #include file = "md5_utf8.asp" -->
<%
'rabtor 2010-8修改完善
Class DNTRestClient
Private parser
Private use_params
Private REST_URI
'Sample function
Public Function createtoken()
Dim redirectURI
redirectURI = replace(REST_URI,"services/restserver.aspx","login.aspx?api_key=" & ApiKey)
response.Redirect redirectURI
End Function
Public Function auth_getsession(auth_token)
use_params.removeall
use_params.add "auth_token",auth_token
result = callapimethod("auth.getSession",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>getsession FAILED???<br>"
Set auth_getsession = Nothing
Else
Set to_ret = server.createobject("scripting.dictionary")
sessionkey=parser.documentelement.getElementsByTagName("session_key").item(0).firstchild.nodevalue
Set docu=parser.documentelement
to_ret.add "session_key",node_value(docu,"session_key")
'response.write sessionkey&":::"&node_value(docu,"uid")&"<br>"
to_ret.add "uid",node_value(docu,"uid")
expire=node_value(docu,"expires")
If expire = 0 Then
to_ret.add "expires","never"
Else
to_ret.add "expires",unix2asp(expire)
End If
Set docu = Nothing
Set auth_getsession = to_ret
Set to_ret = Nothing
End If
End Function
Public Function auth_register(username,password,email,passwordformat) '如果passwordformat为空，则使用md5加密
use_params.removeall
use_params.add "user_name",username
use_params.add "password",password
use_params.add "email",email
use_params.add "password_format",passwordformat
result = callapimethod("auth.register",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>auth_register FAILED!<br>"
Set auth_register = Nothing
Response.end '停止运行，输出错误信息
Else
Dim token
token = parser.documentelement.selectSingleNode("/").text
Set docu = parser.documentelement
Set docu = Nothing
auth_register = token
End If
End Function
Public Function auth_encodepassword(password,passwordformat) '如果passwordformat为空，则使用md5加密
use_params.removeall
use_params.add "password",password
use_params.add "password_format",passwordformat
result = callapimethod("auth.encodepassword",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>auth_encodepassword FAILED???<br>"
Set auth_encodepassword = Nothing
Else
Dim token
token = parser.documentelement.selectSingleNode("/").text
Set docu = parser.documentelement
Set docu = Nothing
auth_encodepassword = token
End If
End Function
'添加论坛版块
Public Function forums_create(forum_info)
use_params.removeall
use_params.add "forum_info",forum_info
result = callapimethod("forums.create",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>forums_create FAILED???<br>"
Set forums_create = Nothing
Else
Dim to_ret,docu
Set to_ret = server.createobject("scripting.dictionary")
Set docu = parser.documentelement
to_ret.add "fid",node_value(docu,"fid")
to_ret.add "url",node_value(docu,"url")
Set docu = Nothing
Set forums_create = to_ret
Set to_ret = Nothing
End If
End Function
'获取指定ID版块的信息
Public Function forums_get(fid)
use_params.removeall
use_params.add "fid",fid
result = callapimethod("forums.get",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>forums_get FAILED???<br>"
Set forums_get = Nothing
Response.end '停止运行，输出错误信息
Else
Dim to_ret,docu
Set to_ret = server.createobject("scripting.dictionary")
Set docu = parser.documentElement
to_ret.add "fid",node_value(docu,"fid")
to_ret.add "url",node_value(docu,"url")
to_ret.add "topics",node_value(docu,"topics")
to_ret.add "current_topics",node_value(docu,"current_topics")
to_ret.add "posts",node_value(docu,"posts")
to_ret.add "today_posts",node_value(docu,"today_posts")
to_ret.add "last_post",node_value(docu,"last_post")
to_ret.add "last_poster",node_value(docu,"last_poster")
to_ret.add "last_poster_id",node_value(docu,"last_poster_id")
to_ret.add "last_tid",node_value(docu,"last_tid")
to_ret.add "last_title",node_value(docu,"last_title")
to_ret.add "description",node_value(docu,"description")
to_ret.add "icon",node_value(docu,"icon")
to_ret.add "moderators",node_value(docu,"moderators")
to_ret.add "rules",node_value(docu,"rules")
to_ret.add "parent_id",node_value(docu,"parent_id")
to_ret.add "path_list",node_value(docu,"path_list")
to_ret.add "parent_id_list",node_value(docu,"parent_id_list")
to_ret.add "sub_forum_count",node_value(docu,"sub_forum_count")
to_ret.add "name",node_value(docu,"name")
to_ret.add "status",node_value(docu,"status")
Set docu = Nothing
Set forums_get = to_ret
Set to_ret = Nothing
End If
End Function
'向指定ID用户发送通知
Public Function notifications_send(to_ids,notification)
use_params.removeall
use_params.add "to_ids",to_ids
use_params.add "notification",notification
result = callapimethod("notifications.send",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>notifications_send FAILED???<br>"
Set notifications_send = Nothing
Else
If parser.documentelement.selectSingleNode("/").text = "1" Then
notifications_send = True
Else
notifications_send = False
End If
End If
End Function
Public Function notifications_sendemail(recipients,subject,text)
use_params.removeall
use_params.add "recipients",recipients
use_params.add "subject",subject
use_params.add "text",text
result = callapimethod("notifications.sendemail",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>notifications_sendemail FAILED???<br>"
Set notifications_sendemail = Nothing
Else
notifications_sendemail = parser.documentelement.selectSingleNode("/").text
End If
End Function
'获取指定ID用户的个人信息
Public Function users_getinfo(uids,fields,sessionkey)
use_params.removeall
use_params.add "uids",uids
If fields = "" Then
fields = "uid,user_name,nick_name,"
If sessionkey <> "" Then
fields = fields & "password,secques,"
End If
fields = fields & "space_id,gender,admin_id,group_id,group_expiry,reg_ip,join_date,"
fields = fields & "last_ip,last_visit,last_activity,last_post,last_post_id,post_count,digest_post_count,online_time,"
fields = fields & "page_view_count,credits,ext_credits_1,ext_credits_2,ext_credits_3,ext_credits_4,ext_credits_5,ext_credits_6,ext_credits_7,"
fields = fields & "ext_credits_8,email,birthday,tpp,ppp,template_id,pm_sound,show_email,invisible,has_new_pm,new_pm_count,access_masks,"
fields = fields & "online_state,web_site,icq,qq,yahoo,msn,skype,location,custom_status,avatar,avatar_width,avatar_height,medals,about_me,"
fields = fields & "sign_html,real_name,id_card,mobile,telephone"
End If
use_params.add "fields",fields
result = callapimethod("users.getinfo",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>users_getinfo FAILED???<br>"
Set users_getinfo = Nothing
Response.end '停止运行，输出错误信息
Else
Dim to_ret,docu,users,i
set users = server.createobject("scripting.dictionary")
Set docu = parser.documentElement
i = 0
For Each node In parser.documentelement.childnodes
Set to_ret = server.createobject("scripting.dictionary")
For Each field In Split(fields,",")
to_ret.add field,node_value(node,field)
Next
users.add i,to_ret
i = i + 1
Next
Set docu = Nothing
Set users_getinfo = users
Set to_ret = Nothing
End If
End Function
Public Function users_setinfo(uid,user_info)
use_params.removeall
use_params.add "uid",uid
use_params.add "user_info",user_info
result = callapimethod("users.setinfo",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>users_setinfo FAILED???<br>"
Set users_setinfo = Nothing
Response.end '停止运行，输出错误信息
Else
If parser.documentelement.selectSingleNode("/").text = "1" Then
users_setinfo = True
Else
users_setinfo = False
End If
End If
End Function
Public Function ChangePassword(uid,original_password,new_password,confirm_new_password) '修改用户密码
use_params.removeall
use_params.add "uid",uid
use_params.add "original_password",original_password
use_params.add "new_password",new_password
use_params.add "confirm_new_password",confirm_new_password
result = callapimethod("users.ChangePassword",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>users_ChangePassword FAILED!<br>"
Set ChangePassword = Nothing
Response.end '停止运行，输出错误信息
Else
ChangePassword = parser.documentelement.selectSingleNode("/").text
End If
End Function
Public Function users_getid(user_name)
use_params.removeall
use_params.add "user_name",user_name
result = callapimethod("users.getid",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>users_getid FAILED!<br>"
Set users_getid = Nothing
Response.end '停止运行，输出错误信息
Else
users_getid = parser.documentelement.selectSingleNode("/").text
End If
End Function
Public Function users_getloggedinuser()
use_params.removeall
result = callapimethod("users.getloggedinuser",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>users_getloggedinuser FAILED???<br>"
Set users_getloggedinuser = Nothing
Response.end '停止运行，输出错误信息
Else
users_getloggedinuser = parser.documentelement.selectSingleNode("/").text
End If
End Function
Public Function users_setextcredits(additional_values)
use_params.removeall
use_params.add "additional_values",additional_values
result = callapimethod("users.setextcredits",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>users_setextcredits FAILED???<br>"
Set users_setextcredits = Nothing
Else
users_setextcredits = parser.documentelement.selectSingleNode("/").text
End If
End Function
'发布帖子，须指定用户ID、论坛版块ID等内容
Public Function topics_create(topic_info)
use_params.removeall
use_params.add "topic_info",topic_info
result = callapimethod("topics.create",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>topics_create FAILED???<br>"
Set topics_create = Nothing
Else
Dim to_ret,docu
Set to_ret = server.createobject("scripting.dictionary")
Set docu = parser.documentElement
to_ret.add "topic_id",node_value(docu,"topic_id")
to_ret.add "url",node_value(docu,"url")
to_ret.add "need_audit",node_value(docu,"need_audit")
Set docu = Nothing
Set topics_create = to_ret
Set to_ret = Nothing
End If
End Function
Public Function topics_reply(reply_info)
use_params.removeall
use_params.add "reply_info",reply_info
result = callapimethod("topics.reply",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>topics_reply FAILED???<br>"
Set topics_reply = Nothing
Response.end '停止运行，输出错误信息
Else
Dim to_ret,docu
Set to_ret = server.createobject("scripting.dictionary")
Set docu = parser.documentElement
to_ret.add "post_id",node_value(docu,"post_id")
to_ret.add "url",node_value(docu,"url")
to_ret.add "need_audit",node_value(docu,"need_audit")
Set docu = Nothing
Set topics_reply = to_ret
Set to_ret = Nothing
End If
End Function
Public Function topics_getrecentreplies(fid,tid,page_size,page_index)
use_params.removeall
use_params.add "fid",fid
use_params.add "tid",tid
use_params.add "page_size",page_size
use_params.add "page_index",page_index
result = callapimethod("topics.getrecentreplies",use_params)
parser.loadxml(result)
If instr(result,"error_response") <> 0 Then
handle_error parser
response.write "<br>topics_getrecentreplies FAILED???<br>"
Set topics_getrecentreplies = Nothing
Response.end '停止运行，输出错误信息
Else
Dim to_ret,docu,posts,i
Set posts = server.createobject("scripting.dictionary")
Set docu = parser.documentElement
i = 0
For Each node In parser.documentelement.childnodes
Set to_ret = server.createobject("scripting.dictionary")
Dim fields
fields = "pid,layer,poster_id,poster_name,title,message,post_date_time,invisible,rate,rate_times,use_signature,"
fields = fields & "poster_email,poster_show_email,poster_avator,poster_avator_width,poster_avator_height,"
fields = fields & "poster_signature,poster_location,ad_index"
For Each field In Split(fields,",")
to_ret.add field,node_value(node,field)
Next
posts.add i,to_ret
i = i + 1
Next
Set docu = Nothing
Set topics_getrecentreplies = posts
Set to_ret = Nothing
End If
End Function
Public Function unix2asp(unix)
unix2asp = DateAdd("s", unix, "01/01/1970 00:00:00")
End Function
Private Sub handle_error(rootnode)
response.write "Error "&node_value(rootnode,"error_code")&": "&node_value(rootnode,"error_msg")&"<br>"
End Sub
Private Function node_value(rootnode,tagname)
'node_value = rootnode.getElementsByTagName(tagname).item(0).firstchild.nodevalue
if rootnode.getElementsByTagName(tagname).length>=1 then 'rabtor添加 避免出现错误：缺少对象: 'rootnode.getElementsByTagName(...).item(...)'
node_value = rootnode.getElementsByTagName(tagname).item(0).text
else
node_value = ""
end if
End Function
Public ApiKey
Public SessionKey
Public SecretKey
' This allows you to call a facebook method (e.g. auth.getSession) with the specified parameters
' You do not need to pass in the following parameters as they are appended automatically,
' - session_key
' - api_key
' - call_id
' - v
Public Function CallApiMethod( strMethod, oParams )
oParams( "method" ) = strMethod
Dim oXMLHTTP
Set oXMLHTTP = Server.CreateObject( "MSXML2.ServerXMLHTTP" )
oXMLHTTP.Open "POST", REST_URI, False, "", ""
oXMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oXMLHTTP.Send(GenerateRequestURI( oParams))
CallApiMethod = oXMLHTTP.ResponseText
Set oXMLHTTP = Nothing
End Function
'Call for initializing
Public Sub Initialize(api_key,secret_key,rest_url)
ApiKey = api_key
SecretKey = secret_key
REST_URI = rest_url
End Sub
Public Sub Initialize2(api_key,secret_key,session_key)
ApiKey = api_key
SecretKey = secret_key
SessionKey = session_key
REST_URI = rest_url
End Sub
Private Sub Class_Initialize()
Set parser = Server.CreateObject("Microsoft.XMLDOM")
Set use_params = server.createobject("Scripting.Dictionary")
end sub
private sub Class_Terminate()
Set parser = Nothing
Set use_params = Nothing
end sub
' Creates the content for a POST to the REST server
Private Function GenerateRequestURI( oParams )
If (Len( Application( "DNT_CallID" ) ) = 0 ) Then Application( "DNT_CallID" ) = 100005
'For auth.getSession (only function to not use session_key?)
if oParams("session_key")="none" Or oParams( "method" ) = "auth.getSession" then
oParams.remove "session_key"
else
oParams( "session_key" ) = SessionKey
end if
oParams( "api_key" ) = ApiKey
oParams( "call_id" ) = Application( "DNT_CallID" )
'oParams( "v" ) = "1.0"
'This is useless for POSTs.
' GenerateRequestURI = REST_URI & "?"
Dim strItem
For Each strItem In oParams.Keys
If oParams(strItem) <> "" Then
GenerateRequestURI = GenerateRequestURI & strItem & "=" & Server.UrlEncode(oParams(strItem)) & "&"
End If
Next
GenerateRequestURI = GenerateRequestURI & "sig=" & GenerateSig( oParams )
'response.write GenerateRequestURI
'response.end
Application( "DNT_CallID" ) = Application( "DNT_CallID" ) + 205
End Function
' This creates an signature of the supplied parameters
Private Function GenerateSig( oParams )
Set oParams = SortDictionary( oParams )
Dim strSig, strItem
For Each strItem In oParams
If oParams( strItem ) <> "" Then
strSig = strSig & strItem & "=" & oParams( strItem )
End If
Next
strSig = strSig & SecretKey
'response.Write strsig & "<br />"
'response.End
'Dim oMD5
'Set oMD5 = New MD5
'oMD5.Text = strSig
'GenerateSig = oMD5.HexMD5
GenerateSig = MD5(strSig)
'response.Write GenerateSig & "<br>"
'GenerateSig = MD5(strSig)
End Function
'Wrapper of generatesig for cookies
public function generatesig_cookies(cookies)
set dict=server.createobject("scripting.dictionary")
for each item in cookies
dict.add item,cookies(item)
next
generatesig_cookies=generatesig(dict)
set dict=nothing
end function
' SortDictionary function courtesy of MSDN
Private Function SortDictionary(objDict)
Dim strDict()
Dim objKey
Dim strKey,strItem
Dim X,Y,Z
Z = objDict.Count
If Z > 1 Then
ReDim strDict(Z,2)
X = 0
For Each objKey In objDict
strDict(X,1) = CStr(objKey)
strDict(X,2) = CStr(objDict(objKey))
X = X + 1
Next
For X = 0 to (Z - 2)
For Y = X to (Z - 1)
If StrComp(strDict(X,1),strDict(Y,1),vbTextCompare) > 0 Then
strKey = strDict(X,1)
strItem = strDict(X,2)
strDict(X,1) = strDict(Y,1)
strDict(X,2) = strDict(Y,2)
strDict(Y,1) = strKey
strDict(Y,2) = strItem
End If
Next
Next
objDict.RemoveAll
For X = 0 to (Z - 1)
objDict.Add strDict(X,1), strDict(X,2)
Next
End If
Set SortDictionary = objDict
End Function
'URLDecode编码替换
'rabtor在2010-8-27添加 URLDecode函数将密码编码后中的所有特殊符号编码替换回来
Function URLDecode(enStr)
dim deStr
dim c,i,v
deStr=""
for i=1 to len(enStr)
c=Mid(enStr,i,1)
if c="%" then
v=eval("&h"+Mid(enStr,i+1,2))
if v<128 then
deStr=deStr&chr(v)
i=i+2
else
if isvalidhex(mid(enstr,i,3)) then
if isvalidhex(mid(enstr,i+3,3)) then
v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
deStr=deStr&chr(v)
i=i+5
else
v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
deStr=deStr&chr(v)
i=i+3
end if
else
destr=destr&c
end if
end if
else
if c="+" then
deStr=deStr&" "
else
deStr=deStr&c
end if
end if
next
URLDecode=deStr
end function
function isvalidhex(str)
isvalidhex=true
str=ucase(str)
if len(str)<>3 then isvalidhex=false:exit function
if left(str,1)<>"%" then isvalidhex=false:exit function
c=mid(str,2,1)
if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
c=mid(str,3,1)
if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
end function
'End URLDecode编码替换
End Class
%>
api_bbs.asp文件：
<!--#include file="RestClient.asp" -->
<%
'rabtor2010-9-7添加
Dim client
'创建API
Set client = New DNTRestClient
'■■■■■■替换为你在论坛后台设置的API Key、密钥和应用程序地址■■■■■■
client.Initialize "a69066a81d9e5ddc8747c29c94bb6895","67a203044c0bb87250ff09a4a4a8d31b","http://bbs.zkshouji.com/services/restserver.aspx"
if request("action")="login" and request("key")<>"" then
'传入要登录的用户名和密码，即可实现该用户的登录。
get_username=request("username")
get_password=request("password")
call bbs_login(get_username,get_password)
end if
if request("action")="register" and request("key")<>"" then
'注册论坛会员
get_username=request("username")
get_password=request("password")
get_email=request("email")
call client.auth_register(get_username,get_password,get_email,"")
end if
if request("action")="updatepwd" and request("key")<>"" then
'修改用户密码
get_username=request("username")
get_password=request("password")
get_password1=request("password1")
get_password2=request("password2")
Dim bbs_userid
bbs_userid = client.users_getid(get_username)
'response.write(bbs_userid)
'response.end
call client.ChangePassword(bbs_userid,get_password,get_password1,get_password2)
end if
if request("action")="logout" and request("key")<>"" then
call logout()
end if
sub bbs_login(byval username,byval password)'rabtor2010-9-7加
dim uid,infos,pass
'根据username获取UID
uid=client.users_getid(username)
'这里获取一些登录后写入cookie的相关用户信息
'包括：密码,每页主题数,每页贴数,短消息铃声,是否隐身
'PS：users_getinfo方法无法获取sigstatus字段的内容(是否显示签名)，所以下面的cookie直接写入1(显示签名)了，无所谓，没什么大影响
set infos=client.users_getinfo(uid,"password,tpp,ppp,pm_sound,invisible","")
'加密密码
'auth_encodepassword方法能对密码进行des加密，用于cookie验证
'第一个参数是密码，可以是md5过的，也可以是原始密码
'第二个参数，如果密码是md5的，这里填“md5”，否则留空即可
'pass=client.auth_encodepassword(infos(0)("password"),"md5") '读取密码方式一：直接读取用户的md5密码
pass=client.auth_encodepassword(password,"") '读取密码方式二：由用户输入密码
'替换编码
'这个比较重要，曾经被这个问题纠结了好半天，一直无法成功登录
'由于auth_encodepassword生成的加密后的密码是编码过的，直接写入cookie的话，百分号会被再次编码成%25，导致重复编码，所以要先把编码替换回来。
'替换编码方法一，这种方法是针对于常见特殊符号，本系统中使用该方法
'rabtor在2010-8-27添加 URLDecode函数将密码编码后中的所有特殊符号编码替换回来
pass=client.URLDecode(pass)
'替换编码方法二，这种方法是针对于个别特殊符号，容易遗漏
'pass=replace(pass,"%2f","/")
'pass=replace(pass,"%3d","=")
'pass=replace(pass,"%2b","+")
'生成cookie
response.cookies("dnt")("userid")=uid
response.cookies("dnt")("password")=pass
response.cookies("dnt")("tpp")=infos(0)("tpp")
response.cookies("dnt")("ppp")=infos(0)("ppp")
response.cookies("dnt")("pmsound")=infos(0)("pm_sound")
response.cookies("dnt")("invisible")=infos(0)("invisible")
response.cookies("dnt")("referer")="index.aspx"
response.cookies("dnt")("sigstatus")=1
response.cookies("dnt")("expires")=120 '过期时间(120分钟)
response.cookies("dnt").expires=dateadd("n",120,now()) '设置过期时间(120分钟)
response.cookies("dnt").domain=".zkshouji.com" '■■■■■■修改为网站的域名,注意前面带.(点)■■■■■■
response.cookies("dnt").secure=false
set infos=nothing
set dnt=nothing
end sub
sub logout()
'退出论坛
response.cookies("dnt")("userid")=""
response.cookies("dnt")("password")=""
response.cookies("dnt")("tpp")=""
response.cookies("dnt")("ppp")=""
response.cookies("dnt")("pmsound")=""
response.cookies("dnt")("invisible")=""
response.cookies("dnt")("referer")=""
response.cookies("dnt")("sigstatus")=""
response.cookies("dnt")("expires")="" '过期时间(120分钟)
response.cookies("dnt").domain=".in-en.com" '■■■■■■修改为网站的域名,注意前面带.(点)■■■■■■
end sub
%>
最后在网站相关的代码文件中加入如下代码即可：
'同步注册论坛会员 rabtor2010-9-7添加
response.write("<script language=""JavaScript"" src=""../api/api_bbs.asp?action=register&username="&Server.URLEncode(strUserName)&"&password="&Server.URLEncode(UserPassWord)&"&email="&Server.URLEncode(usermail)&"&key=z235x6h5c456hv78p05q3w2eopfaw71v""></script>")
'同步登录论坛
response.write("<script language=""JavaScript"" src=""../api/api_bbs.asp?action=login&username="&Server.URLEncode(username)&"&password="&Server.URLEncode(Request("password"))&"&key=z235x6h5c456hv78p05q3w2eopfaw71v""></script>")
'同步退出论坛
'response.write("<script language=""JavaScript"" src=""../api/api_bbs.asp?action=logout&key=z235x6h5c456hv78p05q3w2eopfaw71v""></script>")
'同步更新论坛用户的密码
response.write("<script language=""JavaScript"" src=""../api/api_bbs.asp?action=updatepwd&username="&Server.URLEncode(username)&"&password="&Server.URLEncode(Trim(Request.Form("password")))&"&password1="&Server.URLEncode(Trim(Request.Form("password1")))&"&password2="&Server.URLEncode(Trim(Request.Form("password2")))&"&key=z235x6h5c456hv78p05q3w2eopfaw71v""></script>")
第二节 从论坛同步到网站的应用
主要步骤：
一、开启Discuz!NT论坛的“同步数据模式”功能
在Discuz!NT论坛的后台“扩展”菜单项里单击[通行证设置]，设置如下：
应用程序类型：web
应用程序：Url 地址:http://www.Discuz!NT.com/bbs/services/restserver.aspx
同步数据模式：开启
同步数据的 URL 地址：http://www.Discuz!NT.com/api/api_reponse.asp
（红色网址部分改成你自己的）。
操作界面图：
二、编写处理同步数据文件
这里以asp网站程序为例，其他语言与此类似。本系统中用到的处理论坛同步数据文件为改写新云CMS的api_reponse.asp以便与已有的asp网站整合。
api_reponse.asp主要代码部分：
（由于本系统要求会员注册比较严格，论坛的注册跳转至主网站的会员注册页面）
If Request.QueryString<>"" Then
Act=Request.QueryString("action")
Select Case Act
Case "login" ‘同步会员登录
SaveUserCookie()
Case "logout" '同步会员退出
LogoutUser()
Case "updatepwd" '同步更改会员修改密码
UpdatePWD()
End Select
Else
Sub SaveUserCookie()
Dim S_syskey,Password,usercookies,TruePassWord,userclass,Userhidden
Dim sig
sig = Request.QueryString("sig")
UserName = Inen.CheckBadstr(Request.QueryString("user_name"))
usercookies = Request.QueryString("savecookie")
If UserName="" or sig="" Then Exit Sub
If usercookies="" or Not IsNumeric(usercookies) Then usercookies = 0
ChkUserLogin username,usercookies
End Sub
Function ChkUserLogin(username,usercookies)
ChkUserLogin = False
Dim Rs,SQL,Group_Setting
If Not IsObject(Conn) Then ConnectionDatabase
Set Rs = Server.CreateObject("ADODB.Recordset")
SQL = "SELECT * FROM [IE_User] WHERE username='" & UserName & "'"
Rs.Open SQL, Conn, 1, 3
If Not (Rs.BOF And Rs.EOF) Then
If Rs("UserLock") <> 0 Then
ChkUserLogin = False
Exit Function
End If
Response.Cookies(Inen.Cookies_Name)("LastTimeDate") = Rs("LastTime")
Response.Cookies(Inen.Cookies_Name)("LastTimeIP") = Rs("userlastip")
Response.Cookies(Inen.Cookies_Name)("LastTime") = Rs("LastTime")
Group_Setting=Split(Inen.UserGroupSetting(Rs("UserGrade")), "|||")
If Rs("userpoint") < 0 Then
Rs("userpoint") = CLng(Group_Setting(25))
Else
Rs("userpoint") = Rs("userpoint") + CLng(Group_Setting(25))
End If
If Rs("experience") < 0 Then
Rs("experience") = CLng(Group_Setting(32))
Else
Rs("experience") = Rs("experience") + CLng(Group_Setting(32))
End If
If Rs("charm") < 0 Then
Rs("charm") = CLng(Group_Setting(33))
Else
Rs("charm") = Rs("charm") + CLng(Group_Setting(33))
End If
Rs("LastTime") = Now()
Rs("userlastip") = Inen.GetUserip
Rs("UserLogin") = Rs("UserLogin") + 1
Rs.Update
Select Case usercookies
Case 0
Response.Cookies(Inen.Cookies_Name)("usercookies") = usercookies
Case 1
Response.Cookies(Inen.Cookies_Name).Expires=Date+1
Response.Cookies(Inen.Cookies_Name)("usercookies") = usercookies
Case 2
Response.Cookies(Inen.Cookies_Name).Expires=Date+31
Response.Cookies(Inen.Cookies_Name)("usercookies") = usercookies
Case 3
Response.Cookies(Inen.Cookies_Name).Expires=Date+365
Response.Cookies(Inen.Cookies_Name)("usercookies") = usercookies
End Select
Response.Cookies(Inen.Cookies_Name).path = "/"
Response.Cookies(Inen.Cookies_Name)("userid") = Rs("userid")
Response.Cookies(Inen.Cookies_Name)("username") = Rs("username")
Response.Cookies(Inen.Cookies_Name)("password") = Rs("password")
Response.Cookies(Inen.Cookies_Name)("nickname") = Rs("nickname")
Response.Cookies(Inen.Cookies_Name)("UserGrade") = Rs("UserGrade")
Response.Cookies(Inen.Cookies_Name)("UserGroup") = Rs("UserGroup")
Response.Cookies(Inen.Cookies_Name)("UserClass") = Rs("UserClass")
Response.Cookies(Inen.Cookies_Name)("UserToday") = Rs("UserToday")
ChkUserLogin = True
End If
Rs.Close
Set Rs = Nothing
End Function
Sub UpdatePWD()
Dim Rs,SQL
Dim UserName, UserPass
UserName = Inen.CheckBadstr(Request.QueryString("user_name"))
UserPass = mid(Inen.CheckBadstr(Request.QueryString("password")),9,16)
Status = 1
If UserName = "" or UserPass = "" Then Exit Sub
Set Rs = Server.CreateObject("Adodb.RecordSet")
SQL = "SELECT TOP 1 * FROM [IE_User] WHERE Username='" & UserName & "'"
If Not IsObject(Conn) Then ConnectionDatabase
Rs.Open SQL,Conn,1,3
If Not Rs.Eof And Not Rs.Bof Then
Rs("password") = UserPass
Rs.update
Status = 0
End If
Rs.Close
Set Rs = Nothing
If UserPass <> "" And Status = 0 Then
Response.Cookies(Inen.Cookies_Name)("password") = UserPass
End If
End Sub
Sub LogoutUser()
Response.Cookies(Inen.Cookies_Name).path = "/"
Response.Cookies(Inen.Cookies_Name)("userid") = ""
Response.Cookies(Inen.Cookies_Name)("username") = ""
Response.Cookies(Inen.Cookies_Name)("password") = ""
Response.Cookies(Inen.Cookies_Name)("nickname") = ""
Response.Cookies(Inen.Cookies_Name)("UserGrade") = ""
Response.Cookies(Inen.Cookies_Name)("UserGroup") = ""
Response.Cookies(Inen.Cookies_Name)("UserClass") = ""
Response.Cookies(Inen.Cookies_Name)("UserToday") = ""
Response.Cookies(Inen.Cookies_Name)("usercookies") = ""
Response.Cookies(Inen.Cookies_Name)("LastTimeDate") = ""
Response.Cookies(Inen.Cookies_Name)("LastTimeIP") = ""
Response.Cookies(Inen.Cookies_Name)("LastTime") = ""
Response.Cookies(Inen.Cookies_Name) = ""
End Sub
![[源码和文档分享]基于JavaScript和MySQL的文化平台网站的设计与实现](https://img-blog.csdnimg.cn/20181201173429166.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2RlbW9uZ3dj,size_16,color_FFFFFF,t_70)
![[源码和文档分享]基于JSP的MVC框架实现的图书推荐系统展示平台网站](https://img-blog.csdnimg.cn/2018120117372933.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2RlbW9uZ3dj,size_16,color_FFFFFF,t_70)
![[源码和文档分享]基于C#和SQL SERVER的校园知识问答论坛网站的设计与实现](https://img-blog.csdnimg.cn/2018120209553292.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2RlbW9uZ3dj,size_16,color_FFFFFF,t_70)
![[源码和文档分享]基于JAVA EE和豆瓣API实现的电影评论网站](https://img-blog.csdnimg.cn/20181202095604686.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2RlbW9uZ3dj,size_16,color_FFFFFF,t_70)
![[源码和文档分享]基于Node.js的医药搜索平台网站设计与实现](https://img-blog.csdnimg.cn/20181202100242875.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2RlbW9uZ3dj,size_16,color_FFFFFF,t_70)
![[源码和文档分享]基于Python与Node.js实现的医疗图像库在线存储与检索平台网站...](https://img-blog.csdnimg.cn/20181202100403282.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2RlbW9uZ3dj,size_16,color_FFFFFF,t_70)
![[源码和文档分享]深度学习算法实验平台网站的设计与实现](https://img-blog.csdnimg.cn/20181202100821440.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2RlbW9uZ3dj,size_16,color_FFFFFF,t_70)
![[源码和文档分享]基于JavaEE轻量级SSM框架和Maven构建的校友录网站设计与实现](https://img-blog.csdnimg.cn/20181204140052248.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L2RlbW9uZ3dj,size_16,color_FFFFFF,t_70)
![[源码和文档分享]基于Keras和tensorflow深度学习Python实现的支持人脸识别和情绪分类的社区APP网站和微信小程序...](https://www.write-bug.com/upload/image/73/bdec4209b06822f37cfe4fd406dc64d4.jpg)
![[源码和文档分享]基于C#实现的电影网站数据爬虫和电影网站](https://img2018.cnblogs.com/blog/1558728/201812/1558728-20181212102035502-266602040.png)
