api_response.asp

个人网站比较简短

        rsContacter("MSN") = sPE_Items(conMsn, 1)
        rsContacter("ICQ") = ""
        rsContacter("Yahoo") = ""
        rsContacter("UC") = ""
        rsContacter("Aim") = ""
        rsContacter("Company") = ""
        rsContacter("Department") = ""
        rsContacter("Position") = ""
        rsContacter("Operation") = ""
        rsContacter("CompanyAddress") = ""
        rsContacter("BirthDay") = PE_CDate(sPE_Items(conBirthday, 1))
        rsContacter("IDCard") = ""
        rsContacter("NativePlace") = ""
        rsContacter("Nation") = ""
        If sPE_Items(conSex, 1) = "0" Then
            sPE_Items(conSex, 1) = 1
        ElseIf sPE_Items(conSex, 1) = "1" Then
            sPE_Items(conSex, 1) = 0
        Else
            sPE_Items(conSex, 1) = 2
        End If
        rsContacter("Sex") = sPE_Items(conSex, 1)
        rsContacter("Marriage") = 0
        rsContacter("Education") = 0
        rsContacter("GraduateFrom") = ""
        rsContacter("InterestsOfLife") = ""
        rsContacter("InterestsOfCulture") = ""
        rsContacter("InterestsOfAmusement") = ""
        rsContacter("InterestsOfSport") = ""
        rsContacter("InterestsOfOther") = ""
        rsContacter("Family") = ""
        rsContacter("Income") = 0
        rsContacter("CreateTime") = Now()
        rsContacter("Owner") = ""
        rsContacter("UpdateTime") = Now()
        rsContacter.Update
        rsContacter.Close
        Set rsContacter = Nothing

        Conn.Execute ("update PE_User set ContacterID=" & ContacterID & " where UserID=" & UserID & "")
    End If
End Sub

Sub loginUser()
    Dim strRndPass
    strRndPass = GetRndPassword(16)
    sPE_Items(conPassword, 1) = getNodeText(sPE_Items(conPassword, 0))
    sPE_Items(conPassword, 1) = Md5(sPE_Items(conPassword, 1), 16)
    Dim tRs
    sPE_Items(conUsername, 1) = ReplaceBadChar(sPE_Items(conUsername, 1))
    Set tRs = Conn.Execute("SELECT UserID FROM PE_User WHERE UserName='" & sPE_Items(conUsername, 1) & "' AND UserPassword='" & sPE_Items(conPassword, 1) & "'")
    If tRs.Bof And tRs.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "数据库中没有此用户的记录!"
    End If
    tRs.Close
    Set tRs = Nothing
End Sub

Sub UpdateUser()
    Dim tRs, tUserID
    sPE_Items(conUsername, 1) = ReplaceBadChar(sPE_Items(conUsername, 1))
    Set tRs = Conn.Execute("SELECT UserID FROM PE_User WHERE UserName='" & sPE_Items(conUsername, 1) & "'")
    If tRs.EOF And tRs.Bof Then
        FoundErr = True
        ErrMsg = "数据库中没有此用户的记录!"
    Else
        tUserID = tRs(0)
    End If
    tRs.Close
    Set tRs = Nothing
    If FoundErr Then Exit Sub
    
    prepareData True
    
    Dim tSql
    tSql = "SELECT * FROM PE_User WHERE UserName='" & sPE_Items(conUsername, 1) & "'"
    Set tRs = Server.CreateObject("adodb.recordset")
    tRs.OPEN tSql, Conn, 1, 3
    If sPE_Items(conPassword, 1) <> "" Then
        tRs("UserPassword") = Md5(sPE_Items(conPassword, 1), 16)
    End If
    If sPE_Items(conQuestion, 1) <> "" Then
        tRs("Question") = sPE_Items(conQuestion, 1)
    End If
    If sPE_Items(conAnswer, 1) <> "" Then
        tRs("Answer") = Md5(sPE_Items(conAnswer, 1), 16)
    End If
    If sPE_Items(conEmail, 1) <> "" Then
        tRs("Email") = sPE_Items(conEmail, 1)
    End If
    If sPE_Items(conUserstatus, 1) = "" Then
        sPE_Items(conUserstatus, 1) = "0"
    End If
    Select Case sPE_Items(conUserstatus, 1)
    Case "0"
        tRs("Islocked") = False
    Case "4"
        tRs("Islocked") = True
    Case "1"
        tRs("IsLocked") = True
    Case Else
        tRs("IsLocked") = True
    End Select
    tRs.Update
    tRs.Close
    Dim intIndex, NeedContacter
    NeedContacter = False
    For intIndex = 7 To 20
        If intIndex < 8 Or intIndex > 10 Then
            If sPE_Items(intIndex, 1) <> "" Then
                NeedContacter = True
                Exit For
            End If
        End If
    Next
    If NeedContacter Then
        tSql = "SELECT * FROM PE_Contacter WHERE ContacterID=" & tUserID
        tRs.OPEN tSql, Conn, 1, 3
        If Not (tRs.Bof And tRs.EOF) Then
            If sPE_Items(conEmail, 1) <> "" Then
                tRs("Email") = sPE_Items(conEmail, 1)
            End If
            If sPE_Items(conTruename, 1) <> "" Then
                tRs("TrueName") = sPE_Items(conTruename, 1)
            End If
            If sPE_Items(conZipcode, 1) <> "" Then
                tRs("ZipCode") = sPE_Items(conZipcode, 1)
            End If
            If sPE_Items(conAddress, 1) <> "" Then
                tRs("Address") = sPE_Items(conAddress, 1)
            End If
            If sPE_Items(conMobile, 1) <> "" Then
                tRs("Mobile") = sPE_Items(conMobile, 1)
            End If
            If sPE_Items(conTelephone, 1) <> "" Then
                tRs("OfficePhone") = sPE_Items(conTelephone, 1)
            End If
            If sPE_Items(conHomepage, 1) <> "" Then
                tRs("Homepage") = sPE_Items(conHomepage, 1)
            End If
            If sPE_Items(conQQ, 1) <> "" Then
                tRs("QQ") = sPE_Items(conQQ, 1)
            End If
            If sPE_Items(conMsn, 1) <> "" Then
                tRs("MSN") = sPE_Items(conMsn, 1)
            End If
            If sPE_Items(conBirthday, 1) <> "" Then
                tRs("BirthDay") = PE_CDate(sPE_Items(conBirthday, 1))
            End If
            tRs.Update
        End If
        tRs.Close
        Set tRs = Nothing
    End If
    If Err Then
        Err.Clear
    End If
    
End Sub

Sub DeleteUser()
    Dim arrUserNames, iUserIndex
    Dim rsDel
    Dim delName
    arrUserNames = Split(sPE_Items(conUsername, 1), ",")
    For iUserIndex = 0 To UBound(arrUserNames)
        delName = ReplaceBadChar(arrUserNames(iUserIndex))
        Set rsDel = Conn.Execute("SELECT UserID,ContacterID FROM PE_User WHERE UserName='" & delName & "'")
        If Not (rsDel.EOF And rsDel.Bof) Then
            'On Error Resume Next
            Conn.Execute ("DELETE FROM PE_Favorite WHERE UserID=" & rsDel(0))
            Conn.Execute ("DELETE FROM PE_Contacter WHERE ContacterID=" & rsDel(1))
            Conn.Execute ("DELETE FROM PE_User WHERE UserID=" & rsDel(0))
        End If
        rsDel.Close
        Set rsDel = Nothing
    Next
End Sub

Sub GetUserInfo()
    Dim rsInfo, dsUser, iUserID
    sPE_Items(conUsername, 1) = ReplaceBadChar(sPE_Items(conUsername, 1))
    Set rsInfo = Conn.Execute("SELECT ContacterID,UserName,UserPassword,Email,Question,Answer,RegTime,LastLoginIP,Balance,UserExp,UserPoint,ConsumePoint,PostItems,IsLocked " &_
                 "FROM PE_User WHERE UserName='" & sPE_Items(conUsername,1) & "'")
    If rsInfo.EOF And rsInfo.Bof Then
        FoundErr = True
        ErrMsg = "查询的用户不存在"
        iUserID = "0"
    Else
        iUserID = CStr(rsInfo(0))
        sPE_Items(conPassword, 1) = rsInfo("UserPassword")
        sPE_Items(conEmail, 1) = rsInfo("Email")
        sPE_Items(conQuestion, 1) = rsInfo("Question")
        sPE_Items(conAnswer, 1) = rsInfo("Answer")
        sPE_Items(conJointime, 1) = rsInfo("RegTime")
        sPE_Items(conUserip, 1) = rsInfo("LastLoginIP")
        sPE_Items(conBalance, 1) = rsInfo("Balance")
        sPE_Items(conExperience, 1) = rsInfo("UserExp")
        sPE_Items(conValuation, 1) = rsInfo("UserPoint")
        sPE_Items(conTicket, 1) = rsInfo("ConsumePoint")
        sPE_Items(conPosts, 1) = rsInfo("PostItems")
        sPE_Items(conUserstatus, 1) = rsInfo("IsLocked")
    End If
    
    rsInfo.Close

    If FoundErr Then
        Set rsInfo = Nothing
        Exit Sub
    End If

    If IsNull(iUserID) = False And iUserID <> "" Then
        iUserID = PE_CLng(iUserID)
        If iUserID <> 0 Then
            Set rsInfo = Conn.Execute("SELECT TrueName,Sex,Homepage,QQ,MSN,OfficePhone,Mobile,Province,City,Address,ZipCode,Birthday " &_
                            "WHERE ContacterID=" & iUserID)
            If Not (rsInfo.EOF And rsInfo.Bof) Then
                sPE_Items(conTruename, 1) = rsInfo("TrueName")
                sPE_Items(conSex, 1) = exchangeGender(rsInfo("Sex"))
                sPE_Items(conHomepage, 1) = rsInfo("Homepage")
                sPE_Items(conQQ, 1) = rsInfo("QQ")
                sPE_Items(conMsn, 1) = rsInfo("MSN")
                sPE_Items(conTelephone, 1) = rsInfo("OfficePhone")
                sPE_Items(conMobile, 1) = rsInfo("Mobile")
                sPE_Items(conProvince, 1) = rsInfo("Province")
                sPE_Items(conCity, 1) = rsInfo("City")
                sPE_Items(conAddress, 1) = rsInfo("Address")
                sPE_Items(conZipcode, 1) = rsInfo(Birthday)
            End If
        End If
    End If
End Sub

Function CheckSysKey(iName, iSysKey)
    If IsNull(iName) Or iName = "" Or IsNull(iSysKey) Or iSysKey = "" Then
        CheckSysKey = False
        Exit Function
    End If
    If Len(iSysKey) = 32 Then
        iSysKey = Mid(iSysKey, 9, 16)
    End If
    Dim strPEKey, strPEKeyNew
    strPEKey = Md5(iName&API_Key,16)
    strPEKeyNew = Md5(iName&API_Key,16)
    If LCase(iSysKey) = LCase(strPEKey) Or LCase(iSysKey) = LCase(strPEKeyNew) Then
        CheckSysKey = True
    Else
        CheckSysKey = False
    End If
End Function

Function CheckUserName(iName)
    FoundErr = False
    If CheckUserBadChar(UserName) = False Then
        FoundErr = True
        ErrMsg = ErrMsg & "用户名中含有非法字符"
    End If
    
    If FoundErr = True Then Exit Function
    If iName = "" Or GetStrLen(iName) > UserNameMax Or GetStrLen(iName) < UserNameLimit Then
        FoundErr = True
        ErrMsg = ErrMsg & "请输入用户名(不能大于" & UserNameMax & "小于" & UserNameLimit & ")"
    End If

    If FoundInArr(UserName_RegDisabled, iName, "|") = True Then
        FoundErr = True
        ErrMsg = ErrMsg & "您输入的用户名为系统禁止注册的用户名！"
    End If
    iName = ReplaceBadChar(iName)
    Dim rsCheckReg
    Set rsCheckReg = Conn.Execute("select UserName from PE_User where UserName='" & iName & "'")
    If Not (rsCheckReg.EOF And rsCheckReg.Bof) Then
        FoundErr = True
        ErrMsg = ErrMsg & "“" & iName & "”已经存在！请换一个用户名再试试！"
    End If
    rsCheckReg.Close
    Set rsCheckReg = Nothing
    If FoundErr = True Then
        CheckUserName = False
    Else
        CheckUserName = True
    End If
End Function

Function CheckUserEmail(iEmail)
    Dim rsCheckUser
    If Not EnableMultiRegPerEmail And iEmail <> "" Then
        iEmail = ReplaceBadChar(iEmail)
        Set rsCheckUser = Conn.Execute("SELECT Email FROM PE_User WHERE Email='" & iEmail & "'")
        If Not (rsCheckUser.EOF And rsCheckUser.Bof) Then
            FoundErr = True
            ErrMsg = ErrMsg & "您所填写的Email已经存在！"
            CheckUserEmail = False
        Else
            CheckUserEmail = True
        End If
        rsCheckUser.Close
        Set rsCheckUser = Nothing
    Else
        CheckUserEmail = True
    End If
End Function

%>