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.SetForm objCore.FormatURL("login.asp"), "post", "", True
    objXML.SetInput "Nick", "text", "", "ǳƣ", "", True
    objXML.SetInput "Passwd", "password", "", "룺", "", True
    objXML.SetInput "", "submit", "ȷ", "", "", True
    objXML.Printf "ûע᣿"
    objXML.Println objCore.CreateA("register.asp", "ע", "")
    objXML.Printf "ˣ"
    objXML.Println objCore.CreateA("forget.asp", "ȡ", "")
End Sub

Private Sub doPost()
    Dim MyIO
    Dim strNick, strPass
    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))
        If strNick = "" Then
            strError = "ǳ"
        ElseIf strPass = "" Then
            strError = ""
        ElseIf objUser.Exec("*", "Nick='" & SafeString(strNick) & "'") = False Then
            strError = "ǳƻ"
        ElseIf objUser.Item("Passwd") <> MD5(strPass) Then
            strError = "ǳƻ"
        Else
            blnError = False
            strError = "¼ɹ" & vbCrLf & _
            "Ծʹñվṩķˣ" & vbCrLf & _
            "ʾҳ󣬰ҳֻǩԺͨǩʱվɿٽ"
            Dim strSQL
            objUser.Item("LastLogin") = getTime(Now())
            objUser.Item("LastUsedIP") = objCore.IPAddr
            objUser.Item("LastUserAgent") = Request.ServerVariables("HTTP_USER_AGENT")
            strSQL = "UPDATE $(Table) SET LastUsedIP='$(IP)',LastUsedTime=$(Timeval),LastLogin=$(Timeval),LastUserAgent='$(UserAgent)' WHERE SeqId=$(SeqId)"
            strSQL = Replace(strSQl, "$(Table)", T_USER)
            strSQL = Replace(strSQL, "$(Timeval)", objUser.Item("LastLogin"))
            strSQL = Replace(strSQL, "$(IP)", objUser.Item("LastUsedIP"))
            strSQL = Replace(strSQL, "$(UserAgent)", SafeString(objUser.Item("LastUserAgent")))
            strSQl = Replace(strSQL, "$(SeqId)", objUser.Item("SeqId"))
            SafeExecute strSQL
            Call UpdateMemory
            Dim arrTemp
            arrTemp = MyCache.getCache("WAPmo.Env.Minute")
            arrTemp(0) = arrTemp(0) + 1
            MyCache.setCache "WAPmo.Env.Minute", arrTemp, DateAdd("n", 10, Now())
        End If
    End If
    Set MyIO = Nothing
    objXML.Println strError
    If blnError Then
        Call doGet
    End If
End Sub

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
