api_response.asp

来自「实现一个用JSP、Servlet技术实现的小型物流网站系统。实现功能如下：管理员」· ASP 代码 · 共 441 行 · 第 1/2 页

<%@ LANGUAGE = VBScript CodePage = 936%>
<!-- #include file="../Conn1.asp" -->
<!-- #include file="../inc/class_sys.asp" -->
<!-- #include file="Class_API.asp" -->
<!-- #include file="../inc/md5.asp" -->
<%
Dim FoundErr,ErrMsg
Dim Action,syskey,username,password,CookieDate,appid
Dim Sex,QQ,MSN,UserStatus,TrueName,Birthday,TelePhone,HomePage,userip,email,Question,Answer,province,city,address
Dim oblog,XMLdom,blogAPI
set oblog=new class_sys
oblog.start
If Request.QueryString("syskey")<>"" Then
	syskey=LCase(Request.QueryString("syskey"))
	username=oblog.filt_badstr(Trim(request("username")))
	If ChkSyskey Then
		If Request.QueryString("password")<>"" Then
			password=Trim(request("password"))
			CookieDate=Trim(request("savecookie"))
			If CookieDate="0" Or CookieDate="" Then CookieDate="1"
			oblog.savecookie UserName,PassWord,CookieDate,""
		Else
			Call LogoutUser()
		End If 
	End If 
Else 
	Set blogAPI = New DPO_API_OBLOG
	blogAPI.LoadXmlFile False
	Set XMLdom = Server.CreateObject("Microsoft.XMLDOM")
	XMLdom.Async = False
	XMLdom.Load(Request)
	If API_Enable=False Then 
		ErrMsg=("系统并未开启整合接口！")
		FoundErr=True
		blogAPI.SendResult 1, ErrMsg
		Set blogAPI=Nothing
		Response.End
	End If 
	If XMLdom.parseError.errorCode <> 0 Then
		ErrMsg=("接收数据出错，请重试！")
		FoundErr=True
		blogAPI.SendResult 1, ErrMsg
		Set blogAPI=Nothing
		Response.End
	Else 
		appid = XMLdom.documentElement.selectSingleNode("//appid").text
		syskey = XMLdom.documentElement.selectSingleNode("//syskey").text
		Action = XMLdom.documentElement.selectSingleNode("//action").text
		UserName=oblog.filt_badstr (XMLdom.documentElement.selectSingleNode("//username").text)
	End If 
	If ChkSyskey Then
		Select Case Action
			Case "reguser"
				Call reguser()
			Case "login"
				Call ot_chklogin (UserName,PassWord,CookieDate)
			Case "logout"
				Call LogoutUser()
			Case "update"
				Call ModifyUserInfo()
			Case "delete"
				Call DelUser()
			Case "getinfo"
				Call getuserinfo()
			Case "checkname"
				Call Checkname()
		End Select
	End If 
	'将处理结果返回到类文件中处理以便提交方得到该信息
	If FoundErr Then
		blogAPI.SendResult 1, ErrMsg
	Else
		blogAPI.SendResult 0,""
	End If
	Set XMLdom=Nothing 
	Set blogAPI=Nothing
End If
Set oblog=Nothing 

Sub Checkname()
	Dim chk_regname
	chk_regname=oblog.chk_regname(UserName)
	EMail=oblog.filt_badstr(XMLdom.documentElement.selectSingleNode("//email").text)
	if oblog.CacheConfig(15) = 0 Then
		ErrMsg=ErrMsg&"当前系统已关闭注册！"
		FoundErr=True
		Exit Sub 
	End If
	If oblog.chkiplock() Then
		ErrMsg=ErrMsg&"对不起，你的IP已被锁定,不允许注册！"
		FoundErr=True
		Exit Sub 
	End If
	if UserName="" Then
		ErrMsg=ErrMsg&("用户名不允许为空！")
		FoundErr=True
	End If 
	if chk_regname>0 then 
'		if chk_regname = 1 Then ErrMsg=ErrMsg&("用户名不合规范，只能使用小写字母，数字及下划线！")
		if chk_regname = 2 Then ErrMsg=ErrMsg&("用户名中含有系统不允许的字符！")
		if chk_regname = 3 Then ErrMsg=ErrMsg&("用户名中含有系统保留注册的字符！")
		if chk_regname = 4 Then ErrMsg=ErrMsg&("用户名中不允许全部为数字！")
		If ErrMsg<>"" Then FoundErr=True
	End If
	Dim rstc
	Set rstc=oblog.execute ("select * from oblog_user where username='"&UserName&"'")
	If Not rstc.eof Then 
		ErrMsg=ErrMsg&("用户名已经存在，请更换！")
		FoundErr=True
	End If
	rstc.close
	Set rstc=Nothing
End Sub 
'oblog用户整合的注册函数
Sub reguser()
	Dim chk_regname
	chk_regname=oblog.chk_regname(UserName)
	Call GetXML()
	if oblog.CacheConfig(15) = 0 Then
		ErrMsg="当前系统已关闭注册！"
		FoundErr=True
		Exit Sub 
	End If
	If oblog.chkiplock() Then
		ErrMsg="对不起，你的IP已被锁定,不允许注册！"
		FoundErr=True
		Exit Sub
	End If
	if chk_regname>0 then 
'		if chk_regname = 1 Then ErrMsg=ErrMsg&("用户名不合规范，只能使用小写字母，数字及下划线！")
		if chk_regname = 2 Then ErrMsg=ErrMsg&("用户名中含有系统不允许的字符！")
		if chk_regname = 3 Then ErrMsg=ErrMsg&("用户名中含有系统保留注册的字符！")
		if chk_regname = 4 Then ErrMsg=ErrMsg&("用户名中不允许全部为数字！")
		If ErrMsg<>"" Then FoundErr=True
	End If
	If PassWord="" Then 
		ErrMsg=ErrMsg&("密码不能为空！")
		FoundErr=True
	End If
	If Question="" Then 
		ErrMsg=ErrMsg&("提示问题不能为空！")
		FoundErr=True
	End If
	If Answer="" Then 
	ErrMsg=ErrMsg&("提示答案不能为空！")
			FoundErr=True
	End If
	If EMail="" Then 
		ErrMsg=ErrMsg&("EMail不能为空！")
		FoundErr=True
	End If	 
	If FoundErr=True Then Exit Sub 
	Dim Reguserlevel
	if oblog.CacheConfig(18) = 1 Then reguserlevel=6 else reguserlevel=7
	Dim rsreg
	if Not IsObject(conn) Then link_database
	Set rsreg=server.CreateObject("adodb.recordset")
	rsreg.open "select * from [oblog_user] where UserName='"& oblog.filt_badstr(UserName) &"'",conn,1,3
	If rsreg.eof Then
		rsreg.addnew
		rsreg("UserName")=UserName
		rsreg("PassWord")=md5(PassWord)
		rsreg("Question")=Question
		rsreg("Answer")=md5(Answer)
		rsreg("userEMail")=EMail
		rsreg("user_level")=reguserlevel
		rsreg("blogname")=UserName & "的blog"
		rsreg("user_isbest")=0
		rsreg("province")=province
		rsreg("city")=city
		If oblog.chkdomain(UserName)=False Then
			rsreg("Nickname")=UserName
		End If 
		rsreg("adddate")=ServerDate(Now())
        rsreg("regip") = oblog.userip
        rsreg("lastloginip") = oblog.userip
		rsreg("lastlogintime")=ServerDate(Now())
		rsreg("user_dir") =oblog.setup(8,0)
        rsreg("user_group") = oblog.defaultGroup
        rsreg("scores") = oblog.cacheScores(1)
        rsreg("newbie") = 1
		rsreg.update
		oblog.execute("update oblog_setup set user_count=user_count+1")
		oblog.execute("update oblog_user set user_folder=userid where UserName='"&oblog.filt_badstr(UserName)&"'")
		If oblog.CacheConfig(4)<>"" And oblog.CacheConfig(5) = 1 Then
			Dim user_domainroot,Arr_domainroot,TEMP_domainroot
			TEMP_domainroot=Trim(oblog.CacheConfig(4))
			If InStr(TEMP_domainroot,"|")>0 Then 
				Arr_domainroot=Split(TEMP_domainroot,"|")
				user_domainroot=Arr_domainroot(0)
			Else 
				user_domainroot=TEMP_domainroot
			End If 
			oblog.execute("update oblog_user set user_domain=userid where UserName='"&oblog.filt_badstr(UserName)&"'")
			oblog.execute("update oblog_user set user_domainroot='"&user_domainroot&"' where UserName='"&oblog.filt_badstr(UserName)&"'")
		End If
		oblog.CreateUserDir UserName,1
		rsreg.close
		set rsreg=Nothing
	Else 
		ErrMsg=("用户名已存在，请更换重试！")
		FoundErr=True
		Exit Sub
	End If 
End Sub 
'oblog用户整合的登录函数
Sub ot_chklogin(UserName, PassWord, CookieDate) 
	PassWord=XMLdom.documentElement.selectSingleNode("//password").text
	CookieDate=XMLdom.documentElement.selectSingleNode("//savecookie").text
	userip=oblog.filt_badstr(XMLdom.documentElement.selectSingleNode("//userip").text)
	If UserName="" Then 
		ErrMsg=ErrMsg&("用户名不能为空！")
		FoundErr=True
	End If
	If PassWord="" Then 
		ErrMsg=ErrMsg&("密码不能为空！")
		FoundErr=True
	End If
	If FoundErr=True Then Exit Sub
	PassWord=md5(PassWord)
	Dim rs, sql, userurl