user_regpost.asp

个人网站比较简短

<!--#include file="CommonCode.asp"-->
<!--#include file="../Include/PowerEasy.MD5.asp"-->
<!--#include file="../Include/PowerEasy.SendMail.asp"-->
<!--#include file="../API/API_Config.asp"-->
<!--#include file="../API/API_Function.asp"-->
<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Dim CheckCode, CheckNum, CheckUrl

Call Main
Call CloseConn

Sub Main()
    UserTrueIP = ReplaceBadChar(UserTrueIP)

    Dim UserPassword, PwdConfirm, Question, Answer
    Dim i
    UserName = Trim(Request("UserName"))
    UserPassword = Trim(Request("Password"))
    PwdConfirm = Trim(Request("PwdConfirm"))
    Question = Trim(Request("Question"))
    Answer = Trim(Request("Answer"))
    Email = Trim(Request("Email"))
    CheckCode = LCase(ReplaceBadChar(Trim(Request("CheckCode"))))

    Dim strFields, arrFields, arrTemp, NeedAddContacter
    strFields = "Homepage,主页|QQ,QQ号码|ICQ,ICQ号码|MSN,MSN帐号|Yahoo,雅虎通帐号|UC,UC号码|Aim,Aim帐号|OfficePhone,办公电话|HomePhone,家庭电话|Fax,传真号码|Mobile,手机号码|PHS,小灵通号码|Region,国家/地区＋省市/州郡＋城市|Address,联系地址|ZipCode,邮政编码|TrueName,真实姓名|Birthday,出生日期|IDCard,身份证号码|Vocation,职业|Company,公司/单位名称|Department,部门名称|PosTitle,职务|Marriage,婚姻状态|Income,收入情况|UserFace,用户头像|FaceWidth,头像宽度|FaceHeight,头像高度|Sign,签名档|Privacy,隐私设定"
    arrFields = Split(strFields, "|")

    Randomize
    CheckNum = CStr(Int(7999 * Rnd + 2000)) & CStr(Int(7999 * Rnd + 2000)) '随机验证码
    CheckUrl = Request.ServerVariables("HTTP_REFERER")
    CheckUrl = Left(CheckUrl, InStrRev(CheckUrl, "/")) & "User_RegCheck.asp?Action=Check&UserName=" & UserName & "&Password=" & UserPassword & "&CheckNum=" & CheckNum
    If UserName = "" Or GetStrLen(UserName) > UserNameMax Or GetStrLen(UserName) < UserNameLimit Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请输入用户名(不能大于" & UserNameMax & "小于" & UserNameLimit & ")</li>"
    Else
        If CheckUserBadChar(UserName) = False Then
            ErrMsg = ErrMsg & "<li>用户名中含有非法字符</li>"
            FoundErr = True
        End If
    End If


    If FoundInArr(UserName_RegDisabled, UserName, "|") = True Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>您输入的用户名为系统禁止注册的用户名</li>"
    End If
    If UserPassword = "" Or GetStrLen(UserPassword) > 12 Or GetStrLen(UserPassword) < 6 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请输入密码(不能大于12小于6)</li>"
    Else
        If CheckBadChar(UserPassword) = False Then
            ErrMsg = ErrMsg + "<li>密码中含有非法字符</li>"
            FoundErr = True
        End If
    End If
    If PwdConfirm = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请输入确认密码(不能大于12小于6)</li>"
    Else
        If UserPassword <> PwdConfirm Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>密码和确认密码不一致</li>"
        End If
    End If
    If Question = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>密码提示问题不能为空</li>"
    End If
    If Answer = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>密码答案不能为空</li>"
    End If
    If Email = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>Email不能为空</li>"
    Else
        If IsValidEmail(Email) = False Then
            ErrMsg = ErrMsg & "<li>您的Email有错误</li>"
            FoundErr = True
        End If
    End If
    If EnableCheckCodeOfReg = True Then
        If Trim(Session("CheckCode")) = "" Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>你在注册页面的停留时间过长，导致注册验证码失效。请重新返回注册页面进行注册。</li>"
        End If
        If CheckCode <> Session("CheckCode") Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>您输入的注册验证码和系统产生的不一致，请重新输入。</li>"
        End If
    End If
    If EnableQAofReg = True Then
        Dim arrQAofReg
        arrQAofReg = Split(QAofReg & "", "$$$")
        For i = 0 To 2
            If Trim(arrQAofReg(i * 2)) <> "" Then
                If Trim(Request("RegAnswer" & i)) <> Trim(arrQAofReg(i * 2 + 1)) Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>请正确回答注册验证问题，否则您将不能注册</li>"
                    Exit For
                End If
            End If
        Next
    End If
    For i = 0 To UBound(arrFields)
        arrTemp = Split(arrFields(i), ",")
        If FoundInArr(RegFields_MustFill, arrTemp(0), ",") Then
            NeedAddContacter = True
            If Trim(Request(arrTemp(0))) = "" Or (i = 1 And LCase(Trim(Request(arrTemp(0)))) = "http://") Then
                If arrTemp(0) <> "Region" Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>请填写：" & arrTemp(1) & "</li>"
                ElseIf Trim(Request("Country")) = "" Or Trim(Request("Province")) = "" Or Trim(Request("City")) = "" Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>请填写：" & arrTemp(1) & "</li>"
                End If
            End If
        End If
    Next

    If FoundErr = True Then
        Call ShowRegResult
        Exit Sub
    End If


    Dim sqlReg, rsReg, trs, RndPassword
    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
    sqlReg = "select * from PE_User where UserName='" & UserName & "'"
    Set rsReg = Server.CreateObject("adodb.recordset")
    rsReg.Open sqlReg, Conn, 1, 3
    If Not (rsReg.BOF And rsReg.EOF) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>您注册的用户已经存在！请换一个用户名再试试！</li>"
    Else
        If Not EnableMultiRegPerEmail Then
            Dim rsEmailOnce
            Set rsEmailOnce = Conn.Execute("select UserID from PE_User where Email='" & Email & "'")
            If Not (rsEmailOnce.BOF And rsEmailOnce.EOF) Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>您注册的Email已经存在！请更换Email再试试！</li>"
            End If
            Set rsEmailOnce = Nothing
        End If
    End If
    If FoundErr = True Then
        rsReg.Close
        Set rsReg = Nothing
        Call ShowRegResult
        Exit Sub
    End If

    '添加对整合接口的支持
    If API_Enable Then
        '重置错误状态和信息
        FoundErr = False
        ErrMsg = ""
        '将要发送的信息存入数组
        sPE_Items(conSyskey, 1) = MD5(UserName & API_Key, 16)
        sPE_Items(conAction, 1) = "reguser"
        sPE_Items(conUsername, 1) = UserName
        sPE_Items(conPassword, 1) = UserPassword
        sPE_Items(conQuestion, 1) = Question
        sPE_Items(conAnswer, 1) = Answer
        sPE_Items(conEmail, 1) = Email
        sPE_Items(conUserstatus, 1) = 0
        sPE_Items(conJointime, 1) = Now()
        sPE_Items(conUserip, 1) = UserTrueIP
        sPE_Items(conTruename, 1) = PE_HTMLEncode(Trim(Request.Form("TrueName")))
        sPE_Items(conGender, 1) = exchangeGender(Trim(Request.Form("Sex")))
        sPE_Items(conBirthday, 1) = FormatDateTime(PE_CDate(Trim(Request.Form("Birthday"))), vbShortDate)
        sPE_Items(conQQ, 1) = PE_HTMLEncode(Trim(Request.Form("QQ")))
        sPE_Items(conMsn, 1) = PE_HTMLEncode(Trim(Request.Form("MSN")))
        sPE_Items(conMobile, 1) = PE_HTMLEncode(Trim(Request.Form("Mobile")))
        sPE_Items(conTelephone, 1) = PE_HTMLEncode(Trim(Request.Form("OfficePhone")))
        sPE_Items(conProvince, 1) = PE_HTMLEncode(Trim(Request.Form("Province")))
        sPE_Items(conCity, 1) = PE_HTMLEncode(Trim(Request.Form("City")))
        sPE_Items(conAddress, 1) = PE_HTMLEncode(Trim(Request.Form("Address")))
        sPE_Items(conZipcode, 1) = PE_HTMLEncode(Trim(Request.Form("ZipCode")))
        sPE_Items(conHomepage, 1) = PE_HTMLEncode(Trim(Request.Form("HomePage")))
        If createXmlDom Then
            '支持MSXML，把数据存入xml流
            prepareXML True
            '向整合接口发送注册请求
            SendPost
            If FoundErr Then
                ErrMsg = "<li>" & ErrMsg & "</li>"
            End If
        Else
            '服务器不支持MSXML
            FoundErr = True
            ErrMsg = "<li>目前注册服务不可用! [APIError-XmlDom-Runtime]</li>"
        End If
    End If
    '完毕

    If FoundErr = True Then
        Call ShowRegResult
        Exit Sub
    End If

    RndPassword = GetRndPassword(16)