网站整合discuz!nt论坛 -从论坛同步到网站的应用-同步注册/登录/退出/修改登录密码

在网上参考了很多资料后，终于完美实现了网站和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