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
浙公网安备 33010602011771号