📄 api_reponse.asp
字号:
<!--#include file="../conn.asp"-->
<!--#include file="../inc/const.asp"-->
<!--#include file="../inc/chkinput.asp"-->
<!--#include file="../inc/md5.asp"-->
<!--#include file="cls_api.asp"-->
<%
'=========================================================
'-- File: api_reponse.asp
'-- Version: NewAsp Site Management System 2.1 sp1
'-- Date: 2006-10-11
'-- Script Written by newasp.net
'=========================================================
'-- Copyright (C) 2003,2006 NewAsp.Net. All rights reserved.
'-- Web: http://www.newasp.net,http://www.newasp.cn
'-- Email: newasp@163.com
'-- 声明：本程序修改自动网论坛系统Api接口
'=========================================================
Dim XMLDom,XmlDoc,Node,Status,Messenge
Dim UserName,Act,appid
Status = 1
Messenge = ""
If Request.QueryString<>"" And API_Enable Then
SaveUserCookie()
Else
Set XmlDoc = Server.CreateObject("msxml2.FreeThreadedDOMDocument" & MsxmlVersion)
XmlDoc.ASYNC = False
If API_Enable Then
If Not XmlDoc.LOAD(Request) Then
Status = 1
Messenge = "数据非法，操作中止！"
appid = "未知"
Else
If CheckPost() Then
Select Case Act
Case "checkname"
Checkname()
Case "reguser"
UserReguser()
Case "login"
UesrLogin()
Case "logout"
LogoutUser()
Case "update"
UpdateUser()
Case "delete"
Deleteuser()
Case "lock"
Lockuser()
Case "getinfo"
GetUserinfo()
End Select
End If
End If
Else
Status = 0
Messenge = "API接口关闭，操作中止！"
appid = "newasp"
End If
ReponseData()
Set XmlDoc = Nothing
End If
Sub ReponseData()
If Act <> "getinfo" Then
XmlDoc.loadxml "<root><appid>dvbbs</appid><status>0</status><body><message/></body></root>"
End If
XmlDoc.documentElement.selectSingleNode("appid").text = "newasp"
If API_Debug And Act <> "reguser" Then
XmlDoc.documentElement.selectSingleNode("status").text = 0
Messenge = ""
Else
XmlDoc.documentElement.selectSingleNode("status").text = status
End If
XmlDoc.documentElement.selectSingleNode("body/message").text = ""
Set Node = XmlDoc.createCDATASection(Replace(Messenge,"]]>","]]>"))
XmlDoc.documentElement.selectSingleNode("body/message").appendChild(Node)
Response.Clear
Response.ContentType="text/xml"
Response.CharSet="gb2312"
Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine
Response.Write XmlDoc.documentElement.XML
End Sub
Function CheckPost()
CheckPost = False
Dim Syskey
If XmlDoc.documentElement.selectSingleNode("action") is Nothing or XmlDoc.documentElement.selectSingleNode("syskey") is Nothing or XmlDoc.documentElement.selectSingleNode("username") is Nothing Then
Status = 1
Messenge = Messenge & "<li>非法请求。</li>"
Exit Function
End If
UserName = Newasp.CheckBadstr(XmlDoc.documentElement.selectSingleNode("username").text)
Syskey = XmlDoc.documentElement.selectSingleNode("syskey").text
Act = XmlDoc.documentElement.selectSingleNode("action").text
Appid = XmlDoc.documentElement.selectSingleNode("appid").text
Dim NewMd5,OldMd5
NewMd5 = Md5(UserName & API_ConformKey)
Md5OLD = 1
OldMd5 = Md5(UserName & API_ConformKey)
Md5OLD = 0
If Syskey=NewMd5 or Syskey=OldMd5 Then
CheckPost = True
Else
Status = 1
Messenge = Messenge & "<li>请求数据验证不通过，请与管理员联系。</li>"
End If
End Function
Sub GetUserinfo()
Dim Rs,Sql
XmlDoc.loadxml "<root><appid>dvbbs</appid><status>0</status><body><message/><email/><question/><answer/><savecookie/><truename/><gender/><birthday/><qq/><msn/><mobile/><telephone/><address/><zipcode/><homepage/><userip/><jointime/><experience/><ticket/><valuation/><balance/><posts/><userstatus/></body></root>"
Sql = "SELECT TOP 1 * FROM NC_User WHERE UserName='" & Newasp.CheckBadstr(UserName) & "'"
Set Rs = Newasp.Execute(Sql)
If Not Rs.Eof And Not Rs.Bof Then
XmlDoc.documentElement.selectSingleNode("body/email").text = Rs("usermail") & ""
XmlDoc.documentElement.selectSingleNode("body/question").text = Rs("question") & ""
XmlDoc.documentElement.selectSingleNode("body/answer").text = Rs("answer") & ""
XmlDoc.documentElement.selectSingleNode("body/gender").text = Rs("Usersex") & ""
XmlDoc.documentElement.selectSingleNode("body/birthday").text = ""
XmlDoc.documentElement.selectSingleNode("body/mobile").text = ""
XmlDoc.documentElement.selectSingleNode("body/userip").text = Rs("userlastip") & ""
XmlDoc.documentElement.selectSingleNode("body/jointime").text = Rs("JoinTime") & ""
XmlDoc.documentElement.selectSingleNode("body/experience").text = Rs("experience") & ""
XmlDoc.documentElement.selectSingleNode("body/ticket").text = ""
XmlDoc.documentElement.selectSingleNode("body/valuation").text = Rs("userpoint") & ""
XmlDoc.documentElement.selectSingleNode("body/balance").text = Rs("usermoney") & ""
XmlDoc.documentElement.selectSingleNode("body/posts").text = Rs("postcode") & ""
XmlDoc.documentElement.selectSingleNode("body/userstatus").text = Rs("UserLock")
XmlDoc.documentElement.selectSingleNode("body/homepage").text = Rs("HomePage") & ""
XmlDoc.documentElement.selectSingleNode("body/qq").text = Rs("oicq")
XmlDoc.documentElement.selectSingleNode("body/msn").text = ""
XmlDoc.documentElement.selectSingleNode("body/truename").text = Rs("TrueName") & ""
XmlDoc.documentElement.selectSingleNode("body/telephone").text = Rs("phone") & ""
XmlDoc.documentElement.selectSingleNode("body/address").text = Rs("address") & ""
Status = 0
Messenge = Messenge & "<li>读取用户资料成功。</li>"
Else
Status = 1
Messenge = Messenge & "<li>该用户不存在。</li>"
End If
Rs.Close
Set Rs = Nothing
End Sub
Sub Checkname()
Dim Rs,SQL,UserEmail
UserEmail = Newasp.checkstr(Trim(XmlDoc.documentElement.selectSingleNode("email").text))
If IsValidEmail(UserEmail) = False Then
Messenge = "<li>您的Email有错误！</li>"
Status = 1
Exit Sub
End If
If CInt(Newasp.ChkSameMail) = 1 Then
Set Rs = Newasp.Execute("SELECT userid FROM NC_User WHERE usermail='" & UserEmail & "'")
If Not Rs.EOF Then
Status = 1
Messenge = "<li>此邮箱["&UserEmail&"]已经占用，请您换一个邮箱再注册吧。</li>"
Exit Sub
End If
Rs.Close:Set Rs = Nothing
End If
Set Rs = Newasp.Execute("SELECT username FROM NC_User WHERE username = '" & UserName & "'")
If Not (Rs.bof And Rs.EOF) Then
Status = 1
Messenge = "<li>Sorry！此用户已经存在,请换一个用户名再试！</li>"
Else
Status = 0
Messenge = "<li><font color=red><b>" & UserName & "</b></font> 尚未被人使用，赶紧注册吧！</li>"
End If
Rs.Close:Set Rs = Nothing
End Sub
Sub UserReguser()
Dim nickname,UserPass,UserEmail,Question,Answer,usercookies
Dim strGroupName,Password,usersex,sex
Dim Rs,SQL
UserPass = Newasp.checkstr(XmlDoc.documentElement.selectSingleNode("password").text)
UserEmail = Newasp.checkstr(Trim(XmlDoc.documentElement.selectSingleNode("email").text))
Question = Newasp.checkstr(XmlDoc.documentElement.selectSingleNode("question").text)
Answer = Newasp.checkstr(XmlDoc.documentElement.selectSingleNode("answer").text)
sex = Newasp.ChkNumeric(XmlDoc.documentElement.selectSingleNode("gender").text)
If sex = 0 Then
usersex = "女"
Else
usersex = "男"
End If
usercookies = 1
If UserName = "" Or UserPass = "" Then
Status = 1
Messenge = Messenge & "<li>请填写用户名或密码。"
Exit Sub
End If
If Question = "" Then Question = Newasp.GetRandomCode
If Answer = "" Then Answer = Newasp.GetRandomCode
nickname = UserName
Password = md5(UserPass)
Answer = md5(Answer)
If Newasp.IsValidStr(UserName) = False Then
Messenge = Messenge & "<li>登录账号中含有非法字符！</li>"
Status = 1
Exit Sub
End If
If IsValidEmail(UserEmail) = False Then
Messenge = Messenge & "<li>您的Email有错误！</li>"
Status = 1
Exit Sub
End If
Set Rs = Newasp.Execute("SELECT username FROM NC_User WHERE username='" & UserName & "'")
If Not (Rs.BOF And Rs.EOF) Then
Status = 1
Messenge = Messenge & "<li>Sorry！此用户已经存在,请换一个用户名再试！</li>"
Exit Sub
End If
Rs.Close:Set Rs = Nothing
Set Rs = Newasp.Execute("SELECT username FROM NC_Admin WHERE username='" & UserName & "'")
If Not (Rs.BOF And Rs.EOF) Then
Status = 1
Messenge = Messenge & "<li>Sorry！此用户已经存在,请换一个用户名再试！</li>"
Exit Sub
End If
Rs.Close:Set Rs = Nothing
If CInt(Newasp.ChkSameMail) = 1 Then
Set Rs = Newasp.Execute("SELECT userid FROM NC_User WHERE usermail='" & UserEmail & "'")
If Not Rs.EOF Then
Status = 1
Messenge = Messenge & "<li>对不起！本系统已经限制一个邮箱只能注册一个账号。</li><li>此邮箱["&UserEmail&"]已经占用，请您换一个邮箱再注册吧。</li>"
Exit Sub
End If
Rs.Close:Set Rs = Nothing
End If
'---
Set Rs = Newasp.Execute("SELECT GroupName FROM NC_UserGroup WHERE Groupid=3")
If Rs.BOF And Rs.EOF Then
strGroupName = "普通会员"
Else
strGroupName = Newasp.CheckBadstr(Rs(0))
If Len(strGroupName) = 0 Then strGroupName = "普通会员"
End If
Rs.Close:Set Rs = Nothing
Set Rs = Server.CreateObject("ADODB.Recordset")
SQL = "SELECT * FROM NC_User WHERE (userid is null)"
Rs.Open SQL,Conn,1,3
Rs.Addnew
Rs("username") = UserName
Rs("password") = Password
Rs("nickname") = UserName
Rs("UserGrade") = 1
Rs("UserGroup") = strGroupName
Rs("UserClass") = 0
If CInt(Newasp.AdminCheckReg) = 1 Then
Rs("UserLock") = 1
Else
Rs("UserLock") = 0
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -