api_response.asp

个人网站比较简短

<!-- #Include File = "../Start.asp" -->
<!-- #Include File = "../Include/PowerEasy.Md5.asp" -->
<!-- #Include File = "API_Config.asp"-->
<!-- #Include File = "API_Function.asp"-->
<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************
If API_Enable = False Then Response.End

Dim recXml
sPE_Items(conSyskey, 1) = Trim(Request.QueryString(sPE_Items(conSyskey, 0)))
sPE_Items(conUsername, 1) = Trim(Request.QueryString(sPE_Items(conUsername, 0)))
sPE_Items(conPassword, 1) = Trim(Request.QueryString(sPE_Items(conPassword, 0)))
sPE_Items(conSavecookie, 1) = Trim(Request.QueryString(sPE_Items(conSavecookie, 0)))
If sPE_Items(conSyskey, 1) <> "" Then
    If sPE_Items(conUsername, 1) <> "" Then
        If sPE_Items(conPassword, 1) <> "" Then
            WriteCookies
        Else
            CleanCookies
        End If
    End If
Else
    DealResponse
End If

Sub WriteCookies()
    Dim strRndPass
    If Not CheckSysKey(sPE_Items(conUsername, 1), sPE_Items(conSyskey, 1)) Then
        Exit Sub
    End If
    strRndPass = GetRndPassword(16)
    If sPE_Items(conSavecookie, 1) <> "" Then
        sPE_Items(conSavecookie, 1) = PE_CLng(sPE_Items(conSavecookie, 1))
    End If
    Dim iSubDomainIndex, strSite_Sn
    If Enable_SubDomain Then
        For iSubDomainIndex = 0 To UBound(arrSubDomains)
            strSite_Sn = LCase(arrSubDomains(iSubDomainIndex) & Replace(Replace(DomainRoot & InstallDir, "/", ""), ".", ""))
            Response.Cookies(strSite_Sn).Domain = DomainRoot
            Select Case sPE_Items(conSavecookie, 1)
            Case 0
                'not save
            Case 1
                Response.Cookies(strSite_Sn).Expires = Date + 1
            Case 2
                Response.Cookies(strSite_Sn).Expires = Date + 31
            Case 3
                Response.Cookies(strSite_Sn).Expires = Date + 365
            End Select
            Response.Cookies(strSite_Sn)("UserName") = sPE_Items(conUsername, 1)
            Response.Cookies(strSite_Sn)("UserPassword") = sPE_Items(conPassword, 1)
            Response.Cookies(strSite_Sn)("LastPassword") = strRndPass
            Response.Cookies(strSite_Sn)("CookieDate") = sPE_Items(conSavecookie, 1)
        Next
    Else
        Select Case sPE_Items(conSavecookie, 1)
            Case 0
                'not save
            Case 1
                Response.Cookies(Site_Sn).Expires = Date + 1
            Case 2
                Response.Cookies(Site_Sn).Expires = Date + 31
            Case 3
                Response.Cookies(Site_Sn).Expires = Date + 365
        End Select
        Response.Cookies(Site_Sn)("UserName") = sPE_Items(conUsername, 1)
        Response.Cookies(Site_Sn)("UserPassword") = sPE_Items(conPassword, 1)
        Response.Cookies(Site_Sn)("LastPassword") = strRndPass
        Response.Cookies(Site_Sn)("CookieDate") = sPE_Items(conSavecookie, 1)
    End If
    sPE_Items(conUsername, 1) = ReplaceBadChar(sPE_Items(conUsername, 1))
    UserTrueIP = ReplaceBadChar(UserTrueIP)
    Conn.Execute ("UPDATE PE_User Set LastPassword='" & strRndPass & "',LastLoginIP='" & UserTrueIP & "',LastLoginTime=" & PE_Now & ",LoginTimes=LoginTimes+1 WHERE UserName='" & sPE_Items(conUsername, 1) & "'")
    Session("UserID") = UserID
End Sub

Sub CleanCookies()
    If Not CheckSysKey(sPE_Items(conUsername, 1), sPE_Items(conSyskey, 1)) Then
        Exit Sub
    End If
    Dim iSubDomainIndex, strSite_Sn, iItem
    If Enable_SubDomain Then
        For iSubDomainIndex = 0 To UBound(arrSubDomains)
            strSite_Sn = LCase(arrSubDomains(iSubDomainIndex) & Replace(Replace(DomainRoot & InstallDir, "/", ""), ".", ""))
            Response.Cookies(strSite_Sn).Domain = DomainRoot
            Response.Cookies(strSite_Sn)("UserName") = ""
            Response.Cookies(strSite_Sn)("UserPassword") = ""
            Response.Cookies(strSite_Sn)("LastPassword") = ""
        Next
    Else
        Response.Cookies(Site_Sn)("UserName") = ""
        Response.Cookies(Site_Sn)("UserPassword") = ""
        Response.Cookies(Site_Sn)("LastPassword") = ""
    End If

End Sub

Sub DealResponse()
    'On Error Resume Next
    If createXmlDom Then
        sMyXmlDoc.Load Request
        If sMyXmlDoc.parseError.errorCode <> 0 Then
            FoundErr = True
            ErrMsg = sMyXmlDoc.parseError.reason & "001"
        Else
            sPE_Items(conSyskey, 1) = getNodeText(sPE_Items(conSyskey, 0))
            sPE_Items(conUsername, 1) = getNodeText(sPE_Items(conUsername, 0))
            sPE_Items(conAction, 1) = getNodeText(sPE_Items(conAction, 0))
            
            If sPE_Items(conSyskey, 1) = "" Or sPE_Items(conUsername, 1) = "" Or sPE_Items(conAction, 1) = "" Then
                FoundErr = True
                ErrMsg = "未包含必须元素，数据同步被拒绝!"
            End If
            If Not CheckSysKey(sPE_Items(conUsername, 1), sPE_Items(conSyskey, 1)) Then
                FoundErr = True
                ErrMsg = "安全码不符，数据同步被拒绝!"
            End If
        End If
    Else
        FoundErr = True
        ErrMsg = "服务器不支持MSXML对象。"
    End If
    If Err Then
        FoundErr = True
        ErrMsg = Err.Description
        Err.Clear
        WriteErrXml
        Exit Sub
    End If
    If FoundErr Then
        sPE_Items(conStatus, 1) = "1"
        sPE_Items(conMessage, 1) = ErrMsg
        prepareXML False
        WriteXml
        Exit Sub
    End If
    '已处理的元素：syskey,username
    '错误检测完成，开始处理数据
    sPE_Items(conAction, 1) = getNodeText(sPE_Items(conAction, 0))
    '已处理的元素：syskey,username,action
    Select Case sPE_Items(conAction, 1)
        Case "checkname"
            Call checkUser
        Case "reguser"
            Call createUser
        Case "login"
            Call loginUser
        Case "logout"
            Call CleanCookies
        Case "update"
            Call UpdateUser
        Case "delete"
            Call DeleteUser
        Case "getinfo"
            Call GetUserInfo
    End Select
    If FoundErr Then
        sPE_Items(conStatus, 1) = "1"
        sPE_Items(conMessage, 1) = ErrMsg
        prepareXML (False)
        WriteXml
        Exit Sub
    Else
        sPE_Items(conStatus, 1) = "0"
        prepareXML (False)
        WriteXml
    End If
End Sub

Sub checkUser()
    sPE_Items(conEmail, 1) = getNodeText(sPE_Items(conEmail, 0))
    CheckUserName (sPE_Items(conUsername, 1))
    CheckUserEmail (sPE_Items(conEmail, 1))
End Sub

Sub createUser()
    sPE_Items(conEmail, 1) = getNodeText(sPE_Items(conEmail, 0))
    If CheckUserName(sPE_Items(conUsername, 1)) = False Or CheckUserEmail(sPE_Items(conEmail, 1)) = False Then
        Exit Sub
    End If
    
    prepareData True
    
    Dim sqlReg, rsReg, tRs, RndPassword, CheckNum
    Set tRs = Conn.Execute("select max(UserID) from PE_User")
    If IsNull(tRs(0)) Then
        UserID = 1
    Else
        UserID = tRs(0) + 1
    End If
    Set tRs = Nothing

    RndPassword = GetRndPassword(16)
    Set rsReg = Server.CreateObject("adodb.recordset")
    rsReg.OPEN "SELECT * FROM PE_User WHERE UserID=0", Conn, 1, 3
    rsReg.addnew
    rsReg("UserID") = UserID
    rsReg("ClientID") = 0
    rsReg("ContacterID") = 0
    rsReg("UserType") = 0
    rsReg("UserName") = sPE_Items(conUsername, 1)
    rsReg("UserPassword") = Md5(sPE_Items(conPassword, 1), 16)
    rsReg("LastPassword") = RndPassword
    rsReg("Question") = sPE_Items(conQuestion, 1)
    rsReg("Answer") = Md5(sPE_Items(conAnswer, 1), 16)
    rsReg("Email") = sPE_Items(conEmail, 1)
    rsReg("RegTime") = PE_CDate(sPE_Items(conJointime, 1))
    rsReg("LoginTimes") = 0
    If sPE_Items(conUserstatus, 1) = "1" Then
        rsReg("IsLocked") = True
    Else
        rsReg("IsLocked") = False
    End If
    rsReg("Balance") = PresentMoney
    rsReg("UserExp") = PresentExp
    rsReg("PostItems") = 0
    rsReg("PassedItems") = 0
    rsReg("DelItems") = 0
    rsReg("UnsignedItems") = ""
    rsReg("UnreadMsg") = 0
    rsReg("arrClass_Browse") = ""
    rsReg("arrClass_View") = ""
    rsReg("arrClass_Input") = ""
    rsReg("UserSetting") = ""
    rsReg("UserFriendGroup") = "黑名单$我的好友"
    rsReg("LoginTimes") = 0
    rsReg("LastLoginIP") = ""
    rsReg("LastLoginTime") = Now()
    rsReg("LastPresentTime") = Now()
    If sPE_Items(conUserstatus, 1) = "4" Then
        Set tRs = Conn.Execute("select GroupID,GroupSetting from PE_UserGroup where GroupType=1")
    Else
        Set tRs = Conn.Execute("select GroupID,GroupSetting from PE_UserGroup where GroupType=2")
    End If
    Dim GroupID, GroupSetting
    GroupID = tRs(0)
    GroupSetting = Split(tRs(1), ",")
    Set tRs = Nothing
    rsReg("GroupID") = GroupID
    rsReg("UserPoint") = PresentPoint
    rsReg("BeginTime") = FormatDateTime(Now(), 2)
    rsReg("ValidNum") = PresentValidNum
    rsReg("ValidUnit") = PresentValidUnit
    Randomize
    CheckNum = CStr(Int(7999 * Rnd + 2000)) & CStr(Int(7999 * Rnd + 2000))
    rsReg("CheckNum") = CheckNum
    rsReg("SpecialPermission") = False
    rsReg.Update
    rsReg.Close
    Set rsReg = Nothing

    If PresentMoney > 0 Then
        Conn.Execute ("insert into PE_BankrollItem (UserName,ClientID,DateAndTime,[Money],MoneyType,CurrencyType,eBankID,Bank,Income_PayOut,OrderFormID,PaymentID,Remark,LogTime,IP,Inputer) values('" & UserName & "',0," & PE_Now & "," & PresentMoney & ",4,1,0,'',1,0,0,'注册新用户，赠送资金'," & PE_Now & ",'" & UserTrueIP & "','System')")
    End If
    If PresentPoint > 0 Then
        Conn.Execute ("insert into PE_ConsumeLog (UserName,ModuleType,InfoID,Point,Income_Payout,Remark,LogTime,Times,IP,Inputer) values ('" & UserName & "',0,0," & PresentPoint & ",1,'注册新会员，赠送" & PointName & "'," & PE_Now & ",1,'" & UserTrueIP & "','System')")
    End If
    If PresentValidNum > 0 Or PresentValidNum = -1 Then
        Conn.Execute ("insert into PE_RechargeLog (UserName,ValidNum,ValidUnit,Income_Payout,Remark,LogTime,IP,Inputer) values ('" & UserName & "'," & PresentValidNum & "," & PresentValidUnit & ",1,'注册新会员，赠送有效期'," & PE_Now & ",'" & UserTrueIP & "','System')")
    End If
    
    Dim intIndex, NeedContacter
    NeedContacter = False
    For intIndex = 11 To 20
        If sPE_Items(intIndex, 1) <> "" Then
            NeedContacter = True
            Exit For
        End If
    Next
    
    If NeedContacter Then
        Dim ContacterID, sqlContacter, rsContacter
        Set tRs = Conn.Execute("select max(ContacterID) from PE_Contacter")
        If IsNull(tRs(0)) Then
            ContacterID = 1
        Else
            ContacterID = tRs(0) + 1
        End If
        Set tRs = Nothing

        sqlContacter = "select top 1 * From PE_Contacter"
        Set rsContacter = Server.CreateObject("adodb.recordset")
        rsContacter.OPEN sqlContacter, Conn, 1, 3
        rsContacter.addnew
        rsContacter("ContacterID") = ContacterID
        rsContacter("ClientID") = 0
        rsContacter("ParentID") = 0
        rsContacter("UserType") = 0
        rsContacter("TrueName") = sPE_Items(conTruename, 1)
        rsContacter("Title") = ""
        rsContacter("Country") = ""
        rsContacter("Province") = ""
        rsContacter("City") = ""
        rsContacter("ZipCode") = sPE_Items(conZipcode, 1)
        rsContacter("Address") = sPE_Items(conAddress, 1)
        rsContacter("Mobile") = sPE_Items(conMobile, 1)
        rsContacter("OfficePhone") = sPE_Items(conTelephone, 1)
        rsContacter("HomePhone") = ""
        rsContacter("PHS") = ""
        rsContacter("Fax") = ""
        rsContacter("Homepage") = sPE_Items(conHomepage, 1)
        rsContacter("Email") = sPE_Items(conEmail, 1)
        rsContacter("QQ") = sPE_Items(conQQ, 1)