user_regpost.asp

一本关于大学的书

    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") = 1
    rsReg("LastLoginIP") = UserTrueIP
    rsReg("LastLoginTime") = Now()
    rsReg("LastPresentTime") = Now()
    rsReg("UserFace") = PE_HTMLEncode(Trim(Request.Form("UserFace")))
    rsReg("FaceWidth") = PE_CLng(Trim(Request.Form("FaceWidth")))
    rsReg("FaceHeight") = PE_CLng(Trim(Request.Form("FaceHeight")))
    rsReg("Sign") = PE_HTMLEncode(Trim(Request.Form("Sign")))
    rsReg("Privacy") = PE_CLng(Trim(Request.Form("Privacy")))
    If EmailCheckReg = True Then
        Dim strMailBody
        strMailBody = Replace(EmailOfRegCheck, "{$CheckNum}", CheckNum)
        strMailBody = Replace(strMailBody, "{$CheckUrl}", CheckUrl)

        Dim PE_Mail
        Set PE_Mail = CreateObject("PE_Common6.SendMail")
        PE_Mail.iConn = Conn
        ErrMsg = PE_Mail.Send(Email, UserName, "注册确认信", strMailBody, SiteName, WebmasterEmail, 3)
        Set PE_Mail = Nothing
        Set trs = Conn.Execute("select GroupID,GroupSetting from PE_UserGroup where GroupType=0")
    Else
        If AdminCheckReg = True 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
    End If
    Dim GroupID, GroupSetting
    GroupID = trs(0)
    GroupSetting = Split(trs(1), ",")
    Set trs = Nothing
    rsReg("GroupID") = GroupID
    'rsReg("ChargeType") = GroupSetting(14)
    rsReg("UserPoint") = PresentPoint
    rsReg("BeginTime") = FormatDateTime(Now(), 2)
    rsReg("ValidNum") = PresentValidNum
    rsReg("ValidUnit") = PresentValidUnit
    rsReg("CheckNum") = CheckNum
    rsReg("SpecialPermission") = False
    rsReg.Update
    rsReg.Close
    Set rsReg = Nothing
    Response.Cookies(Site_Sn)("UserName") = UserName
    Response.Cookies(Site_Sn)("UserPassword") = Md5(UserPassword, 16)
    Response.Cookies(Site_Sn)("LastPassword") = RndPassword
    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

    If NeedAddContacter = True 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") = PE_HTMLEncode(Trim(Request.Form("TrueName")))
        rsContacter("Title") = PE_HTMLEncode(Trim(Request.Form("Title")))
        rsContacter("Country") = PE_HTMLEncode(Trim(Request.Form("Country")))
        rsContacter("Province") = PE_HTMLEncode(Trim(Request.Form("Province")))
        rsContacter("City") = PE_HTMLEncode(Trim(Request.Form("City")))
        rsContacter("ZipCode") = PE_HTMLEncode(Trim(Request.Form("ZipCode")))
        rsContacter("Address") = PE_HTMLEncode(Trim(Request.Form("Address")))
        rsContacter("Mobile") = PE_HTMLEncode(Trim(Request.Form("Mobile")))
        rsContacter("OfficePhone") = PE_HTMLEncode(Trim(Request.Form("OfficePhone")))
        rsContacter("HomePhone") = PE_HTMLEncode(Trim(Request.Form("HomePhone")))
        rsContacter("PHS") = PE_HTMLEncode(Trim(Request.Form("PHS")))
        rsContacter("Fax") = PE_HTMLEncode(Trim(Request.Form("Fax")))
        rsContacter("Homepage") = PE_HTMLEncode(Trim(Request.Form("Homepage")))
        rsContacter("Email") = Email
        rsContacter("QQ") = PE_HTMLEncode(Trim(Request.Form("QQ")))
        rsContacter("MSN") = PE_HTMLEncode(Trim(Request.Form("MSN")))
        rsContacter("ICQ") = PE_HTMLEncode(Trim(Request.Form("ICQ")))
        rsContacter("Yahoo") = PE_HTMLEncode(Trim(Request.Form("Yahoo")))
        rsContacter("UC") = PE_HTMLEncode(Trim(Request.Form("UC")))
        rsContacter("Aim") = PE_HTMLEncode(Trim(Request.Form("Aim")))
        rsContacter("Company") = PE_HTMLEncode(Trim(Request.Form("Company")))
        rsContacter("Department") = PE_HTMLEncode(Trim(Request.Form("Department")))
        rsContacter("Position") = PE_HTMLEncode(Trim(Request.Form("PosTitle")))
        rsContacter("Operation") = PE_HTMLEncode(Trim(Request.Form("Operation")))
        rsContacter("CompanyAddress") = PE_HTMLEncode(Trim(Request.Form("CompanyAddress")))
        rsContacter("BirthDay") = PE_CDate(Trim(Request.Form("BirthDay")))
        rsContacter("IDCard") = Left(PE_HTMLEncode(Trim(Request.Form("IDCard"))), 20)
        rsContacter("NativePlace") = PE_HTMLEncode(Trim(Request.Form("NativePlace")))
        rsContacter("Nation") = PE_HTMLEncode(Trim(Request.Form("Nation")))
        rsContacter("Sex") = PE_CLng(Trim(Request.Form("Sex")))
        rsContacter("Marriage") = PE_CLng(Trim(Request.Form("Marriage")))
        rsContacter("Education") = PE_CLng(Trim(Request.Form("Education")))
        rsContacter("GraduateFrom") = PE_HTMLEncode(Trim(Request.Form("GraduateFrom")))
        rsContacter("InterestsOfLife") = PE_HTMLEncode(Trim(Request.Form("InterestsOfLife")))
        rsContacter("InterestsOfCulture") = PE_HTMLEncode(Trim(Request.Form("InterestsOfCulture")))
        rsContacter("InterestsOfAmusement") = PE_HTMLEncode(Trim(Request.Form("InterestsOfAmusement")))
        rsContacter("InterestsOfSport") = PE_HTMLEncode(Trim(Request.Form("InterestsOfSport")))
        rsContacter("InterestsOfOther") = PE_HTMLEncode(Trim(Request.Form("InterestsOfOther")))
        rsContacter("Family") = PE_HTMLEncode(Trim(Request.Form("Family")))
        rsContacter("Income") = PE_CLng(Trim(Request.Form("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

    Call ShowRegResult
End Sub

Sub ShowRegResult()
    Set PE_Site = Server.CreateObject("PE_Common6.Site")
    PE_Site.iConnStr = ConnStr
    PE_Site.iSystemDatabaseType = SystemDatabaseType
    PE_Site.CurrentChannelID = 0
    PE_Site.Init

    strHTML = PE_Site.GetTemplate(0, 21, 0)
    strHTML = PE_Site.ReplaceCommon(strHTML)

    Dim strPath
    strPath = "您现在的位置：&nbsp;<a href='" & SiteUrl & "'>" & SiteName & "</a>&nbsp;&gt;&gt;&nbsp;注册结果"

    strHTML = Replace(strHTML, "{$PageTitle}", SiteTitle & " >> 注册结果")
    strHTML = Replace(strHTML, "{$ShowPath}", strPath)


    strHTML = Replace(strHTML, "{$MenuJS}", PE_Site.GetMenuJS("", False))
    strHTML = Replace(strHTML, "{$Skin_CSS}", PE_Site.GetSkin_CSS(0))

    strHTML = Replace(strHTML, "{$RegResult}", GetRegResult())

    Set PE_Site = Nothing
    Response.Write strHTML
End Sub

Function GetRegResult()
    Dim strResult
    If FoundErr = True Then
        strResult = strResult & "<br><br><table align='center' width='300' border='0' cellpadding='2' cellspacing='0'>"
        strResult = strResult & "<tr><td align='center' class='main_title_575'>由于以下的原因不能注册用户！</td></tr>"
        strResult = strResult & "<tr><td align='left' height='100' class='main_tdbg_575'><br>" & ErrMsg & "<p align='center'>【<a href='javascript:onclick=history.go(-1)'>返 回</a>】<br></p></td></tr>"
        strResult = strResult & "</table>"
    Else
        strResult = strResult & "<br><br><table align='center' width='300' border='0' cellpadding='2' cellspacing='0'>"
        strResult = strResult & "<tr><td align='center' class='main_title_575'>成功注册用户！</td></tr>"
        strResult = strResult & "<tr><td align='left' height='100' class='main_tdbg_575'><br>您注册的用户名：" & UserName & "<br>"
        If EmailCheckReg = True Then
            strResult = strResult & "系统已经发送了一封确认信到您注册时填写的信箱中，您必须在收到确认信并通过确认信中链接进行确认后，您才能正式成为本站的注册用户。"
        Else
            If EnableWap = True And ShowWapShop = True Then
                strResult = strResult & "您的手机交易码：" & CheckNum & "<br>"
            End If
            If AdminCheckReg = True Then
                strResult = strResult & "请等待管理通过您的注册申请后，您就可以正式成为本站的注册用户了。"
            Else
                If API_Enable Then
                    Dim iIndex, tempAPIScripts
                    sPE_Items(conSyskey, 1) = Md5(UserName & API_Key, 16)
                    For iIndex = 0 To UBound(arrAPIUrls)
                        Dim arrAPIUrl
                        arrAPIUrl = Split(arrAPIUrls(iIndex), "@@")
                        tempAPIScripts = tempAPIScripts & "<script type=""text/javascript"" language=""JavaScript"" src=""" & arrAPIUrl(1) & "?syskey=" & sPE_Items(conSyskey, 1) & "&username=" & UserName & "&password=" & Md5(sPE_Items(conPassword, 1), 16) & """></script>"
                    Next
                    strResult = strResult & tempAPIScripts
                End If
                strResult = strResult & "欢迎您的加入！！！<br><br>"
            End If
        End If
        strResult = strResult & "<p align='center'>【<a href='" & strInstallDir & "Index.asp'>返回首页</a>】<br></p></td></tr>"
        strResult = strResult & "</table>"
    End If
    GetRegResult = strResult

End Function


Function CheckBadChar(strChar)
    Dim strBadChar, arrBadChar, i
    strBadChar = "@@,+,',--,%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & ""
    arrBadChar = Split(strBadChar, ",")
    If strChar = "" Then
        CheckBadChar = False
    Else
        For i = 0 To UBound(arrBadChar)
            If InStr(strChar, arrBadChar(i)) > 0 Then
                CheckBadChar = False
                Exit Function
            End If
        Next
    End If
    CheckBadChar = True
End Function

Function CheckUserBadChar(strChar)
    Dim strBadChar, arrBadChar, i
    strBadChar = "',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & ",*,|,"""
    arrBadChar = Split(strBadChar, ",")
    If strChar = "" Then
        CheckUserBadChar = False
    Else
        For i = 0 To UBound(arrBadChar)
            If InStr(strChar, arrBadChar(i)) > 0 Then
                CheckUserBadChar = False
                Exit Function
            End If
        Next
    End If
    CheckUserBadChar = True
    
End Function

'**************************************************
'函数名：PE_HTMLEncode
'作  用：将html 标记替换成 能在IE显示的HTML
'参  数：fString ---- 要处理的字符串
'返回值：处理后的字符串
'**************************************************
Public Function PE_HTMLEncode(ByVal fString)
    If IsNull(fString) Or Trim(fString) = "" Then
        PE_HTMLEncode = ""
        Exit Function
    End If
    fString = Replace(fString, ">", "&gt;")
    fString = Replace(fString, "<", "&lt;")

    fString = Replace(fString, Chr(32), "&nbsp;")
    fString = Replace(fString, Chr(9), "&nbsp;")
    fString = Replace(fString, Chr(34), "&quot;")
    fString = Replace(fString, Chr(39), "&#39;")
    fString = Replace(fString, Chr(13), "")
    fString = Replace(fString, Chr(10) & Chr(10), "</P><P>")
    fString = Replace(fString, Chr(10), "<BR>")

    PE_HTMLEncode = fString
End Function

%>