Public Sub answerAdd(ByVal username As String)
            Dim tmpObj As Object = HttpContext.Current.Application(getAppName())
            HttpContext.Current.Application.Lock()
            '判断存值含有当前日期的hashtable
            If Not tmpObj Is Nothing Then
                Dim ht As Hashtable = CType(tmpObj, Hashtable)
                '判断hashtable中是否存在相应的用户
                Dim tmpHtItem As Object = ht(username)
                If Not tmpHtItem Is Nothing Then
                    Dim count As Integer = CInt(tmpHtItem) + 1
                    ht.Item(username) = count
                    HttpContext.Current.Application(getAppName) = ht
                    HttpContext.Current.Application.UnLock()
                Else
                    ht.Add(username, "1")
                    HttpContext.Current.Application(getAppName) = ht
                    HttpContext.Current.Application.UnLock()
                End If
            Else
                createApp(username)
            End If

        End Sub
        Public Sub createApp(ByVal username As String)
            Dim tmpHt As Hashtable = New Hashtable
            tmpHt.Add(username, "1")
            HttpContext.Current.Application(getAppName) = tmpHt
            HttpContext.Current.Application.UnLock()
        End Sub
        Public Function ifUserCount(ByVal username As String, ByVal CatelyID As String) As Boolean
            Dim strCatelyID() As String = {"50", "50"}
            Dim tmpObj As Object = HttpContext.Current.Application(getAppName)
            If Not tmpObj Is Nothing Then
                Dim ht As Hashtable = CType(tmpObj, Hashtable)
                Dim tmpHtItem As Object = ht(username)
                If Not tmpHtItem Is Nothing Then
                    If CInt(tmpHtItem) < strCatelyID(CatelyID - 1) Then
                        answerAdd(username)
                        Return True
                    Else
                        Return False
                    End If
                Else
                    answerAdd(username)
                    Return True
                End If
            Else
                answerAdd(username)
                Return True
            End If
        End Function

        Public Function getAppName() As String
            '取得当前application中存放的hashtable 名称
            Dim dt As Date = New DateTime
            getAppName = dt.Now.ToString("yyyyMMdd")
        End Function
    End Class

posted on 2008-10-06 09:53  麦兜  阅读(369)  评论(1)    收藏  举报