#register.mo

WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品

                clsCmd("status") = 9999
                clsCmd.CommandType = "INSERT"
                clsCmd.Add "username", clsCmd("username")
                clsCmd.Add "passwd", clsCmd("passwd")
                Select Case TBBS.Env("retake")
                Case "qa"
                    clsCmd.Add "question", clsCmd("question")
                    clsCmd.Add "answer", clsCmd("answer")
                    If TBBS.Env("passwd_by_email") = TBBS_TRUE Then
                        clsCmd.Add "email", clsCmd("email")
                    End If
                Case "email"
                    clsCmd.Add "email", clsCmd("email")
                Case Else
                    clsCmd.Add "mobile", clsCmd("mobile")
                    If TBBS.Env("passwd_by_email") = TBBS_TRUE Then
                        clsCmd.Add "email", clsCmd("email")
                    End If
                End Select
                clsCmd.Add "face", clsCmd("face")
                clsCmd.Add "sex", clsCmd("sex")
                clsCmd.Add "birthday", clsCmd("birthday")
                clsCmd.Add "address", clsCmd("address")
                clsCmd.Add "homepage", clsCmd("homepage")
                clsCmd.Add "qq", clsCmd("qq")
                clsCmd.Add "msn", clsCmd("msn")
                clsCmd.Add "intro", clsCmd("intro")
                clsCmd.Add "replyhint", clsCmd("reply_hint")
                clsCmd.Add "signature", clsCmd("signature")
                clsCmd.Add "coin", clsCmd("coin")
                clsCmd.Add "cent", clsCmd("cent")
                clsCmd.Add "witchery", clsCmd("witchery")
                clsCmd.Add "topics", clsCmd("topics")
                clsCmd.Add "replies", clsCmd("replies")
                clsCmd.Add "souls", clsCmd("souls")
                clsCmd.Add "deletes", clsCmd("deletes")
                clsCmd.Add "favs", clsCmd("favs")
                clsCmd.Add "state" , clsCmd("state")
                clsCmd.Add "logincount", clsCmd("logincount")
                If TBBS.Env("reg_need_examine") = TBBS_TRUE And TBBS.Env("passwd_by_email") = TBBS_FALSE Then
                    clsCmd.Add "lastlogintime", clsCmd("lastlogintime")
                    clsCmd.Add "lastloginip", clsCmd("lastloginip")
                    clsCmd.Add "online", clsCmd("online")
                End If
                clsCmd.Add "groupid", clsCmd("groupid")
                clsCmd.Add "groupname", clsCmd("groupname")
                clsCmd.Add "groupimg", clsCmd("groupimg")
                clsCmd.Add "regtime", clsCmd("regtime")
                clsCmd.Add "regip", clsCmd("regip")
                clsCmd.Add "source", clsCmd("source")
                clsCmd.Add "status", clsCmd("status")
                clsCmd.Exec
                clsCmd("seqid") = MyKernel.DB.GetIdentity(T_USER)
                If TBBS.Env("passwd_by_email") = TBBS_FALSE And TBBS.Env("reg_need_examine") = TBBS_FALSE Then
                    TBBS.UserAsync clsCmd
                End If
                TBBS.Env("last_username") = TBBS.Vars("username")
                TBBS.Env("index_user") = atol(TBBS.Env("index_user")) + 1
                TBBS.Vars("state") = 6
                If TBBS.Vars("refer") <> "" Then
                    TBBS.Redirect TBBS.Vars("refer")
                    TBBS.AddHint "referer", Array(TBBS.Vars("refer"))
                Else
                    TBBS.Redirect "index.asp"
                End If
                TBBS.UpdateGroupCount clsCmd("groupid"), "+", 1
                TBBS.SetXMLCache "Groups"
            End If
        End If
        Set clsCmd = Nothing
        If TBBS.Vars("state") = 6 Then
            If TBBS.Env("reg_welcome") = TBBS_TRUE Then
                TBBS.SendMessage TBBS.Env("bbs_name"), TBBS.Vars("username"), GetWelcomeTitle(), GetWelcomeMessage(), False
            End If
        End If
    End If
    Session.Contents.Remove "validate"
End Sub

Private Function ValidRetake()
    Dim ret
    ret = False
    Select Case TBBS.Env("retake")
    Case "qa"
        If TBBS.Vars("question") = "" Then
            TBBS.AddHint "empty_question", Array()
        ElseIf Len(TBBS.Vars("question")) > 255 Then
            TBBS.AddHint "question_too_long", Array()
        ElseIf TBBS.Vars("answer") = "" Then
            TBBS.AddHint "empty_answer", Array()
        ElseIf Len(TBBS.Vars("answer")) > 255 Then
            TBBS.AddHint "answer_too_long", Array()
        Else
            ret = True
        End If
    Case "email"
        If TBBS.Vars("email") = "" Then
            TBBS.AddHint "empty_email", Array()
        ElseIf Not ValidEmail(TBBS.Vars("email")) Then
            TBBS.AddHint "invalid_email", Array()
        ElseIf Len(TBBS.Vars("email")) > 255 Then
            TBBS.AddHint "email_too_long", Array()
        Else
            ret = True
        End If
    Case Else
        If Not ValidMobile(TBBS.Vars("mobile")) Then
            TBBS.AddHint "invalid_mobile", Array(TBBS.Vars("mobile"))
        Else
            ret = True
        End If
    End Select
    ValidRetake = ret
End Function

Private Function ValidEmail2()
    Dim ret
    ret = False
    If TBBS.Env("passwd_by_email") = TBBS_TRUE And TBBS.Env("retake") <> "email" Then
        If TBBS.Vars("email") = "" Then
            TBBS.AddHint "empty_email", Array()
        ElseIf Not ValidEmail(TBBS.Vars("email")) Then
            TBBS.AddHint "invalid_email", Array()
        ElseIf Len(TBBS.Vars("email")) > 255 Then
            TBBS.AddHint "email_too_long", Array()
        Else
            ret = True
        End If
    Else
        ret = True
    End If
    ValidEmail2 = ret
End Function

Private Function RegRequire(ByVal strField)
    RegRequire = InString(TBBS.Env("reg_require"), strField, False)
End Function

Private Function EmailExists(ByVal strEmail)
    EmailExists = False
    If TBBS.Env("one_email") = TBBS_FALSE Then Exit Function
    If strEmail = "" Then Exit Function
    Dim strSQL
    strSQL = MyKernel.DB.GetLimitSQL(1, "SEQID", T_USER, "EMAIL='$(Email)'", "", "")
    strSQL = Replace(strSQL, "$(Email)", SafeString(strEmail))
    EmailExists = MyKernel.DB.HasRow(strSQL)
End Function

Private Function ValidInterval()
    Dim intInterval
    intInterval = atol(TBBS.Env("reg_interval"))
    If intInterval < 0 THen
        ValidInterval = True
        Exit Function
    End If
    Dim strSQL
    Dim intTime
    strSQL = MyKernel.DB.GetLimitSQL(1, "REGTIME", T_USER, "REGIP='$(IP)'", "", "REGTIME DESC")
    strSQL = Replace(strSQL, "$(IP)", MyIO.Env("REMOTE_ADDR"))
    intTime = atol(MyKernel.DB.GetRow(strSQL))
    If intTime = 0 Then
        ValidInterval = True
    Else
        ValidInterval = CBool(TBBS.Vars("time") - intTime > intInterval)
    End If
End Function

Private Function GetEmailSubject()
    Dim ret
    ret = TBBS.Env("subject")
    ret = Replace(ret, "[bbs_name]", TBBS.Env("bbs_name"))
    GetEmailSubject = ret
End Function

Private Function GetEmailBody()
    Dim ret
    ret = MyKernel.Resource("moex.twinbbs.email")
    ret = Replace(ret, "[bbs_name]", TBBS.Env("bbs_name"))
    ret = Replace(ret, "[username]", TBBS.Vars("username"))
    ret = Replace(ret, "[password]", TBBS.Vars("passwd"))
    ret = Replace(ret, "[host]", MyIO.Env("HTTP_HOST"))
    ret = Replace(ret, "[time]", FormatTime(Now(), "Y-m-d"))
    GetEmailBody = ret
End Function

Private Function GetWelcomeTitle()
    Dim ret
    ret = TBBS.Env("welcome_title")
    ret = Replace(ret, "[bbs_name]", TBBS.Env("bbs_name"))
    ret = Replace(ret, "[username]", TBBS.Vars("username"))
    GetWelcomeTitle = ret
End Function

Private Function GetWelcomeMessage()
    Dim ret
    ret = MyKernel.Resource("moex.twinbbs.welcome")
    ret = Replace(ret, "[bbs_name]", TBBS.Env("bbs_name"))
    ret = Replace(ret, "[username]", TBBS.Vars("username"))
    GetWelcomeMessage = ret
End Function

Private Function GetGroupInfo(ByVal lngId)
    Dim xmlDoc, xmlNode
    Dim strSQL, ret(2)
    Set xmlDoc = TBBS.GetXMLCache("Groups")
    If lngId > 0 Then
        Set xmlNode = XMLQuery(xmlDoc.documentElement, "group[@seqid = " & lngId & "]")
    Else
        Set xmlNode = XMLQuery(xmlDoc.documentElement, "group[@flag = " & GROUP_MEMBER & "]")
    End If
    If Not xmlNode Is Nothing Then
        ret(0) = xmlNode.getAttribute("seqid")
        ret(1) = xmlNode.getAttribute("name")
        ret(2) = xmlNode.getAttribute("groupimg")
    Else
        Err.Raise vbObjectError + 1, "Register.GetGroupInfo", "Missing GroupID"
    End If
    Set xmlNode = Nothing
    Set xmlDoc = Nothing
    GetGroupInfo = ret
End Function