请人看看这代码
请高手把这代码放到窗体上！Imports System.Web
Imports System.Web.SessionState
Imports
Public Class Global
Inherits System.Web.HttpApplication
#Region " 组件设计器生成的代码 "
Public Sub New()
MyBase.New()
'该调用是组件设计器所必需的。
InitializeComponent()
'在 InitializeComponent() 调用之后添加任何初始化
End Sub
'组件设计器所必需的
Private components As
'注意: 以下过程是组件设计器所必需的
'可以使用组件设计器修改此过程。
'不要使用代码编辑器修改它。
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
components = New ()
End Sub
#End Region
Sub Application_Start(ByVal sender As Object, ByVal e As EventArgs)
' 在应用程序启动时激发
Application("GuestCounter") = 0
Application("CurrentGuest") = 0
End Sub
Sub Session_Start(ByVal sender As Object, ByVal e As EventArgs)
' 在会话启动时激发
Dim i As Integer
Dim datastr, count As String
Dim stream As FileStream
Dim strreadobj As StreamReader
Dim strwriterobj As StreamWriter
'读取访问次数
stream = New FileStream(Server.MapPath("Counter.txt"), filemode.openorCreate, FileAccess.Read)
strreadobj = New StreamReader(stream)
datastr = strreadobj.ReadLine()
strreadobj.Close()
'将访问数加一
count = CInt(datastr) + 1
'将访问次数赋给application变量]
Application("GuestCounter") = count
'将访问次数写入计数文件
stream = New filestream(Server.MapPath("counter.txt"), filemode.open, FileAccess.write)
strwriterobj = New streamwriter(stream)
strwriterobj.writeline(count)
strwriterobj.close()
'将当前在线人数加一
Application("currentguest") += 1
End Sub
Sub Application_BeginRequest(ByVal sender As Object, ByVal e As EventArgs)
' 在每个请求开始时激发
End Sub
Sub Application_AuthenticateRequest(ByVal sender As Object, ByVal e As EventArgs)
' 尝试对使用进行身份验证时激发
End Sub
Sub Application_Error(ByVal sender As Object, ByVal e As EventArgs)
' 在发生错误时激发
End Sub
Sub Session_End(ByVal sender As Object, ByVal e As EventArgs)
' 在会话结束时激发
Application("currentguest") -= 1
End Sub
Sub Application_End(ByVal sender As Object, ByVal e As EventArgs)
' 在应用程序结束时激发
End Sub
End Class
----------------------------------------
<Script Language="VB" Runat="Server">
'RefreshTime 变量一定要在此声明，否则无法在网页中以 <%= RefreshTime %> 方式访问
Dim RefreshTime As Integer
Sub Page_Load(sender as Object, e as Eventargs)
Dim IdleTime, Num, I As Integer
Dim Tmp(), ID As String
RefreshTime = 10 '设置网页自动更新时间为 10 秒
IdleTime = RefreshTime * 3 '设置闲置时间为自动更新时间的 3 倍
Application.Lock
'清点所有连接到此网页的浏览器，然后将目前打开的浏览器的 SessionID 放入数组的最后
If Application(Session.SessionID & "LastAccessTime") = Nothing Then
If Application("TotalUsers") = Nothing Then Application.Set("TotalUsers", 0)
ReDim Tmp(Application("TotalUsers") + 1)
Num = 0
If Application("TotalUsers") > 0 Then
For I = Application("OnlineUser").GetLowerBound(0) To Application("OnlineUser").GetUpperBound(0)
ID = Application("OnlineUser")(I)
If ID <> Session.SessionID Then
Tmp(Num) = ID
Num += 1
End If
Next
End If
Tmp(Num) = Session.SessionID
Application.Set("TotalUsers", Num + 1)
ReDim Preserve Tmp(Application("TotalUsers"))
Application.Set("OnlineUser", Tmp)
End If
'记录目前打开的浏览器的最近访问时间
Application.Set(Session.SessionID & "LastAccessTime", Timer)
'检查所有连接到此网页的浏览器的最近访问时间，若与目前时间相差 30 秒以上，表示结束连接
ReDim Tmp(Application("TotalUsers"))
Num = 0
For I = 0 To Application("TotalUsers") - 1
ID = Application("OnlineUser")(I)
If (Timer - Application(ID & "LastAccessTime")) < IdleTime Then
Tmp(Num) = ID
Num += 1
Else
Application.Set(ID & "LastAccessTime", Nothing)
End If
Next
'Num 表示目前在线人数, 若与 Application("TotalUsers") 不同, 表示中间有人断线
If Num <> Application("TotalUsers") Then
ReDim Preserve Tmp(Num)
Application.Set("OnlineUser", Tmp)
Application.Set("TotalUsers", Num)
End If
myCounter.Text = "目前在线人数：" & Application("TotalUsers")
Application.UnLock
End Sub
</Script>
<Html>
<Head>
<Meta Http-Equiv="Refresh" Content="<%= RefreshTime %>, Url=<%= Request.ServerVariables("Url") %>">
</Head>
<Body>
<Asp:Label Runat="Server" Id="myCounter" />
</Body>
</Html>
