Private objAPI
Private objCore
Private objXML
Private objUser
Private strReferer

Private Sub Class_Initialize()
    Set objAPI = New WAPmoAPI
    Set objCore = objAPI.Core
    Set objXML = objCore.XMLParser
    Set objUser = objCore.User
End Sub

Private Sub Class_Terminate()
    Set objUser = Nothing
    Set objXML = Nothing
    Set objCore = Nothing
    Set objAPI = Nothing
End Sub

Public Sub main()
    strReferer = Request.QueryString("Referer")
    If strReferer <> "" Then
        objCore.Query("Referer") = strReferer
    End If
    objXML.Align = "center"
    objXML.Println MyKernel.Config("SiteName") & "Աע"
    objXML.Align = "left"
    If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
        Call doPost
    Else
        Call doGet
    End If
    If strReferer <> "" Then
        objCore.Query("Referer") = Empty
        objXML.Println objCore.CreateA(strReferer, "ٷ", objCore.CreateImg("back.gif", ""))
    End If
    objCore.ExportBackHome "1", "ҳ"
    objXML.Println ""
End Sub

Private Sub doGet()
    objXML.Println "Ϊ*ı"
    objXML.SetForm objCore.FormatURL("register.asp"), "post", "", True
    objXML.SetInput "Nick", "text", "", " [*]", " ӢĻ֣ܳ20ֽڣ10֣", True
    objXML.SetInput "Passwd", "password", "", " [*]", " 6λ", True
    objXML.SetInput "Mobile", "text", "", "ֻ룺", " ֻȡƾ֤", True, 11, 0, "NNNNNNNNNNN"
    objXML.SetInput "", "submit", "ȷ", "", "", True
    objXML.Printf "Ѿעˣ"
    objXML.Println objCore.CreateA("login.asp", "˵¼", "")
    objXML.Printf "ˣ"
    objXML.Println objCore.CreateA("forget.asp", "ȡ", "")
End Sub

Private Sub doPost()
    Dim MyIO
    Dim strNick, strPass, strMobile
    Dim blnError
    Dim strError
    Set MyIO = Server.CreateObject("WMCore.IIO")
    blnError = True
    If MyIO.Parse(KBYTE) <> 0 Then
        strError = "󳤶ȣ" & KBYTE
    Else
        strNick = Trim(MyIO.Form("Nick", 65001))
        strPass = Trim(MyIO.Form("Passwd", 65001))
        strMobile = Trim(MyIO.Form("Mobile", 65001))
        If strNick = "" Then
            strError = "ǳ"
        ElseIf strPass = "" Then
            strError = ""
        ElseIf strMobile <> "" And ValidMobile(strMobile) = False Then
            strError = "ֻʽ"
        ElseIf InString(MyKernel.Config("ForbidName"), strNick, False) = True Then
            strError = "ǳѱռ"
        ElseIf ValidName(strNick) = False Then
            strError = "ҪǳʹӢԼַ"
        ElseIf objUser.Exec("*", "Nick='" & SafeString(strNick) & "'") = True Then
            strError = "ǳѱռ"
        ElseIf LenC(strNick) > 20 Then
            strError = "ǳƵĳȲܳ20ֽڣ10֣"
        ElseIf Len(strPass) < 6 Then
            strError = "λ벻С6"
        Else
            blnError = False
            strError = "ϲΪ[" & Mykernel.Config("SiteName") & "]Ա" & vbCrLf & _
            "ǳƣ" & strNick & vbCrLf & _
            "룺" & strPass & vbCrLf & _
            "Ծʹñվṩķˣ"
            Dim strSQL
            Dim lngUserId
            Dim lngTime
            lngUserId = getUserId() + 1
            lngTime = getTime(Now())
            strSQL = "INSERT INTO $(Table) (Nick,Passwd,Mobile,UserId,Status,RegisterTime,RegisterIP,FirstUsedTime,FirstUsedIP,VisitCount,PageCount,FirstUserAgent,LastLogin,MarkerTotal,LastBook,BookTotal,LastRemark,RemarkTotal,MsgSend,MsgRecv,MsgNew) VALUES ('$(Nick)','$(Passwd)','$(Mobile)',$(UserId),$(Status),$(Timeval),'$(IP)',$(Timeval),'$(IP)',0,0,'$(UserAgent)',$(Timeval),0,0,0,0,0,0,0,0)"
            strSQL = Replace(strSQl, "$(Table)", T_USER)
            strSQL = Replace(strSQL, "$(Nick)", SafeString(strNick))
            strSQL = Replace(strSQL, "$(Passwd)", MD5(strPass))
            strSQL = Replace(strSQL, "$(Mobile)", strMobile)
            strSQL = Replace(strSQL, "$(UserId)", lngUserId)
            strSQL = Replace(strSQL, "$(Status)", USER_REGISTER)
            strSQL = Replace(strSQL, "$(Timeval)", lngTime)
            strSQL = Replace(strSQL, "$(IP)", objCore.IPAddr)
            strSQL = Replace(strSQL, "$(UserAgent)", SafeString(Request.ServerVariables("HTTP_USER_AGENT")))
            SafeExecute strSQL
            setUserId lngUserId
            If objUser.Exec("*", "UserId=" & lngUserId) Then
                Call UpdateMemory
            End If
            Dim arrTemp
            arrTemp = MyCache.getCache("WAPmo.Env.Day")
            arrTemp(0) = arrTemp(0) + 1
            MyCache.setCache "WAPmo.Env.Day", arrTemp, DateAdd("d", 1, Date())
        End If
    End If
    Set MyIO = Nothing
    objXML.Println strError
    If blnError Then
        Call doGet
    End If
End Sub

Private Function getUserId()
    Dim lngId
    lngId = vbsre.cache("WAPmo.UserId")
    If IsEmpty(lngId) Then
        lngId = atol(getRecord("SELECT MAX(UserId) FROM " & T_USER))
    End If
    If lngId <= 0 Then lngId = WM_USERID
    getUserId = lngId
End Function

Public Sub setUserId(ByVal lngId)
    vbsre.cache("WAPmo.UserId") = lngId
End Sub

Private Function ValidName(ByVal strName)
    Dim i
    Dim c
    For i = 1 To Len(strName)
        c = Asc(Mid(strName, i, 1))
        If isascii(c) Then
            If isalnum(c) = False Then
                ValidName = False
                Exit Function
            End If
        End If
    Next
    ValidName = True
End Function

Private Sub UpdateMemory()
    Dim objMem
    Dim arrCols
    Dim arrCol
    Set objMem = MyKernel.Memory
    objMem.Expires = 60 * 24 * atol(MyKernel.Config("Timeout"))
    arrCols = MyKernel.TableX(T_USER)
    For Each arrCol In arrCols
        objMem(arrCol(0)) = objUser.Item(arrCol(0))
    Next
    Set objMem = Nothing
End Sub
