api_response.asp

重庆宽频P2P电影小偷程序,可以做一个大型的电影站了

        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)
        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") = ""
        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(connUsername,1) = ReplaceBadChar(sPE_Items(connUsername,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(connUsername,1) = ReplaceBadChar(sPE_Items(connUsername,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 GroupID_ok, GroupID_chk
    GroupID_ok = Conn.Execute("SELECT GroupID FROM PE_UserGroup WHERE GroupType=2")(0)
    GroupID_chk = Conn.Execute("SELECT GroupID FROM PE_UserGroup WHERE GroupType=1")(0)
    On Error Resume Next
    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
            tRs("GroupID") = GroupID_ok
        Case "4"
            tRs("Islocked") = True
            tRs("GroupID") = GroupID_chk
        Case "1"
            tRs("IsLocked") = True
            tRs("GroupID") = GroupID_ok
        Case Else
            tRs("IsLocked") = True
            tRs("GroupID") = GroupID_ok
    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 (tSql.Bof And tSql.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(conMsg,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
    arrUserNames = Split(sPE_Items(conUsername,1),",")
    For iUserIndex = 0 to Ubound(arrUserNames)
        Dim rsDel
        Dim delName
        delName = ReplaceBadChar(arrUsernames(iUserIndex))
        Set rsDel = Conn.Execute("SELECT UserID 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 UserID=" & rsDel(0))
            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)
    Md5OLD = 0
    strPEKeyNew = Md5(iName&API_Key,16)
    Md5OLD = 1
    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 InStr(iName, "=") > 0 Or InStr(iName, "%") > 0 Or InStr(iName, Chr(32)) > 0 Or InStr(iName, "?") > 0 Or InStr(iName, "&") > 0 Or InStr(iName, ";") > 0 Or InStr(iName, ",") > 0 Or InStr(iName, "'") > 0 Or InStr(iName, ",") > 0 Or InStr(iName, Chr(34)) > 0 Or InStr(iName, Chr(9)) > 0 Or InStr(iName, "