<%
'--------------------------------------
'本文件用于第三方系統(tǒng)反向整合DedeCms在相關(guān)程序調(diào)用的接口
'調(diào)用本文件的接口函數(shù)前必須不能輸出任何字符
'使用本接口的系統(tǒng)必須引用md5及base64編碼算法(DVBBS里的inc/md5.asp、inc/base64.asp)
'--------------------------------------

Dim cfg_cookie_encode,domain,DedeAPI_Url,cfg_loginJumpUrl,cfg_regJumpUrl,cfg_editJump,cfg_exitJump

'這里請(qǐng)?zhí)顚?xiě)DedeCms系統(tǒng)的cookie加密碼
cfg_cookie_encode = ""

'Cookie主域名(用 "abc.com" 形式，不要加主機(jī)名)
'如你的論壇為 bbs.abc.com 主站為 www.abc.com 
'那么域名應(yīng)該是  abc.com ，論壇的主域名和主站的主域名必須是相同的，否則將無(wú)法登陸
domain = "dedecms.com"

'DedeCms通行證接口網(wǎng)址
'如果程序裝在根目錄，一般為 http://www.abc.com/member/passport/pp_dederemote_asp.php
'如果你不想讓人知道dedecms這個(gè)接口(pp_dederemote.php)的真實(shí)網(wǎng)址，你也可以把它改其它名稱(chēng)
DedeAPI_Url = "http://www.dedecms.com/member/passport/pp_dederemote_asp.php"


'登錄成功后跳轉(zhuǎn)的網(wǎng)址     （空按第三方系統(tǒng)默認(rèn)）
cfg_loginJumpUrl = "/member/index.php"

'注冊(cè)成功后跳轉(zhuǎn)的網(wǎng)址     （空按第三方系統(tǒng)默認(rèn)）
cfg_regJumpUrl = "/member/index.php"

'更改資料成功后跳轉(zhuǎn)的網(wǎng)址 （空按第三方系統(tǒng)默認(rèn)）
cfg_editJump = ""      

'退出后跳轉(zhuǎn)到的網(wǎng)址       （空按第三方系統(tǒng)默認(rèn)）
cfg_exitJump = ""



'----------------------------------
'第三方系統(tǒng)與Dedecms系統(tǒng)同步注冊(cè)、登錄、更改密碼、退出接口函數(shù)
'SynchDedeCms($userid,$action,$userpwd="",$kptime="36000",$newuserpwd="",$email="",$sex="",$uname="")
'參數(shù)說(shuō)明
'-------------------------
'userid          用戶(hù)登錄的用戶(hù)名，必須
'action          動(dòng)作，必須，選項(xiàng)為：reg edit login exit test(測(cè)試用戶(hù)ID是否存在)
'userpwd=""      注冊(cè)(reg)或登錄(login)時(shí)必須使用
'kptime="36000" cookie保存時(shí)間，單位為秒
'newuserpwd=""   新密碼，修改密碼時(shí)必須使用
'email=""        Email 注冊(cè)時(shí)選用
'sex=""          性別，男或女 注冊(cè)時(shí)選用
'uname=""        用戶(hù)昵稱(chēng)，注冊(cè)時(shí)選用，空則用 $userid
'返回值：
'返回字串前三位為OK!表示操作成功
'返回其它則是錯(cuò)誤提示
'--------------------------
Function SynchDedeCms(userid,action,kptime)
	 Dim cpath,keys,querystr,v,signstr,headerStr,rcdata,okdata,okGoUrl
	 Dim headerStrs
	 Dim kys
	 Dim ls
	 Dim ds
	 if kptime="" then kptime = 1
	 Set ds = CreateObject("Scripting.Dictionary")
	 ds.Add "userid",userid
	 ds.Add "action",action
	 ds.Add "kptime",kptime
	 if domain<>"" then
	    cpath = ""
	 else
	 	cpath = "/"
	 end if
	 
	 keys = Array("userid","action","kptime")
   querystr = ""
   For Each v In keys
   	  if ds(v)<>"" then 
   	  	querystr = querystr & v & "=" & Server.UrlEncode(ds(v)) & "&"
   	  end if
   Next
   
   signstr = Left(MD5(userid & cfg_cookie_encode,32),24)
   querystr = querystr & "signstr=" & signstr
   okGoUrl = DedeAPI_Url & "?rmdata=" & Server.UrlEncode(querystr)
   
   rcdata = GetRmData(okGoUrl)
   
   if Len(rcdata) < 3 then
   	 SynchDedeCms = ""
   end if
   if Left(rcdata,3) = "OK!" then
   	  okdata = Replace(rcdata,"OK!","")
   	  'Response.Write rcdata
   	  'Response.End
   	  If okdata<>"" then
   	  	headerStr = Trim(okdata)
   	  	PutCookie "DedeUserID",headerStr,kptime,cpath,domain
   	  	PutCookie "DedeUserIDckMd5",left(MD5(cfg_cookie_encode & headerStr,32),16),kptime,cpath,domain
   	  End If
   	  SynchDedeCms = "OK"
   else
      SynchDedeCms = rcdata
   end if
End Function

Function GetRmData(surl)
  Dim xHttp
  set xHttp = Server.CreateObject("microsoft.xmlhttp")
  xHttp.open "GET",surl,false
  xHttp.send()
  GetRmData = xHttp.responseText
End Function


'按默認(rèn)參數(shù)設(shè)置一個(gè)Cookie
Sub PutCookie(key,svalue,kptime,pa,dm)
	 if pa = "" then pa = "/"
	 svalue = trim(svalue)
	 Response.Cookies(key) = svalue
	 Response.Cookies(key).Expires = Date+kptime
	 if dm <> "" then
	 	 Response.Cookies(key).Domain = dm
	 end if
	 Response.Cookies(key).Path = pa
End Sub

%>