DominicH
04-01-2004, 09:23 AM
I have quite a complex global.asa that is creating an Active Users List on my site.
It also sets stuff up for my new forumthats arriving shortly.
Problem is recently the Active User List hasnt been working properly and there has been a major memory leak somehere, I suspect its the global.asa as I have checked all other files for open connections etc.
Below is the global.asa - can anyone see anything bad? So far I have removed all the lines that set the usserArry back to "" - is this a bad thing?
I have removed certain portions for security.
<script language="vbscript" runat="server">
Sub Application_OnStart
Application("Dataconn") = "DSN=(mydsnhere)"
Application("Active") = 0
Dim usersArray()
ReDim usersArray(9, 11) '8 Columns, 10 Rows'
Dim maxUsers
maxUsers = -1
Application("usersArray") = usersArray
Application("maxUsers") = maxUsers
Application("Home") = "default.asp" '09.09.2003 ' add the default page of the main site
Application("Test") = "" '09.09.2003
End Sub
Sub Application_OnEnd
End Sub
Sub Session_OnStart
Session.Timeout = 20
Session("Start") = Now
Application("Dataconn") = "DSN=(mydsnhere)"
'***************************************************'
' Create a session identity in usersArray'
'***************************************************'
Dim usersArray, maxUsers
Application.Lock
'### 09.09.2003
AITfname= Request.Cookies("FirstName")
AITsname=Request.Cookies("SurName")
AITfname = trim(AITfname + " " + AITsname)
AITpwd=Request.Cookies("AITPWD")
if len(AITfname) > 0 and len(AITpwd) > 0 then
strTemppath= request.ServerVariables("path_info")
Application("Test") = strTemppath
if instr(1,ucase(strTemppath),"FORUM1") > 0 then
strPath = "connect.asp?Name=" + AITfname + "&Password=" + AITpwd + "&Indic=G&Test=1"
else
strPath = "forum1\connect.asp?Name=" + AITfname + "&Password=" + AITpwd + "&Indic=G&Test=2"
end if
' response.redirect strPath
end if
'#### 09.09.2003
usersArray = Application("usersArray")
maxUsers = Application("maxUsers")
If maxUsers >= UBound(usersArray, 2) Then
ReDim Preserve usersArray(9, maxUsers + 11) 'Add an additional 10 rows'
End If
If Request.Cookies("Surname")<>"" Then
Dim aArray
For aArray = 0 to UBound(usersArray, 2) 'Check if returning (before timeout) has removed name from array'
If usersArray(7, aArray) = Request.Cookies("NewID")("ID") Then
Application("usersArray") = usersArray
Application("maxUsers") = maxUsers
Application.Unlock
Exit Sub
End If
Next
maxUsers = maxUsers + 1 'Add to the Array if Cookies exist but has timed out since'
usersArray(0, maxUsers) = Session.SessionID
usersArray(1, maxUsers) = Request.Cookies("FirstName") & " " & Request.Cookies("SurName")
usersArray(2, maxUsers) = Request.Cookies("Service")
usersArray(3, maxUsers) = Request.Cookies("Regiment")
usersArray(4, maxUsers) = Request.Cookies("Rank")
usersArray(5, maxUsers) = Request.Cookies("YearSignedUp")
usersArray(6, maxUsers) = Request.Cookies("YearLeft")
usersArray(7, maxUsers) = Request.Cookies("NewID")("ID")
usersArray(8, maxUsers) = Request.Cookies("StartDate")
usersArray(9, maxUsers) = Request.Cookies("OldPhoto")
Application("Active") = Application("Active") + 1
Else 'If no Cookies are stored on the user''s computer, just add them to the array as Guest'
maxUsers = maxUsers + 1
usersArray(0, maxUsers) = Session.SessionID
usersArray(1, maxUsers) = "Guest"
usersArray(2, maxUsers) = "Unknown"
usersArray(3, maxUsers) = "Unknown"
usersArray(4, maxUsers) = "Unknown"
usersArray(5, maxUsers) = "xxxx"
usersArray(6, maxUsers) = "xxxx"
usersArray(7, maxUsers) = "Unknown"
usersArray(8, maxUsers) = "Guest"
usersArray(9, maxUsers)=""
Application("Active") = Application("Active") + 1
End If
Application("usersArray") = usersArray
Application("maxUsers") = maxUsers
Application.Unlock
End Sub 'Session On_Start'
'***************************************************'
' End session identity'
'***************************************************'
'***************************************************'
' Remove user from the Application Array'
'***************************************************'
Sub Session_OnEnd
Dim iCycle
Application.Lock
usersArray = Application("usersArray")
maxUsers = Application("maxUsers")
For iCycle = 0 to UBound(usersArray, 2)
If usersArray(0, iCycle) = Session.SessionID Then
' usersArray(0, iCycle) = ""
' usersArray(1, iCycle) = ""
' usersArray(2, iCycle) = ""
' usersArray(3, iCycle) = ""
' usersArray(4, iCycle) = ""
' usersArray(5, iCycle) = ""
' usersArray(6, iCycle) = ""
' usersArray(7, iCycle) = ""
' usersArray(8, iCycle) = ""
' usersArray(9, iCycle) = ""
Dim jCycle
For jCycle = iCycle to (UBound(usersArray, 2) - 1)
If usersArray(0, jCycle + 1) = "" Then Exit For
usersArray(0, jCycle) = usersArray(0, jCycle + 1)
usersArray(1, jCycle) = usersArray(1, jCycle + 1)
usersArray(2, jCycle) = usersArray(2, jCycle + 1)
usersArray(3, jCycle) = usersArray(3, jCycle + 1)
usersArray(4, jCycle) = usersArray(4, jCycle + 1)
usersArray(5, jCycle) = usersArray(5, jCycle + 1)
usersArray(6, jCycle) = usersArray(6, jCycle + 1)
usersArray(7, jCycle) = usersArray(7, jCycle + 1)
usersArray(8, jCycle) = usersArray(8, jCycle + 1)
usersArray(9, jCycle) = usersArray(9, jCycle + 1)
usersArray(0, jCycle + 1) = ""
usersArray(1, jCycle + 1) = ""
usersArray(2, jCycle + 1) = ""
usersArray(3, jCycle + 1) = ""
usersArray(4, jCycle + 1) = ""
usersArray(5, jCycle + 1) = ""
usersArray(6, jCycle + 1) = ""
usersArray(7, jCycle + 1) = ""
usersArray(8, jCycle + 1) = ""
usersArray(9, jCycle + 1) = ""
Next
maxUsers = maxUsers - 1
Application("Active") = Application("Active") - 1
Exit For
End If
Next
Application("usersArray") = usersArray
Application("maxUsers") = maxUsers
Application.Unlock
End Sub 'Session On_End'
'***************************************************'
' End Remove user'
'***************************************************'
</script>
It also sets stuff up for my new forumthats arriving shortly.
Problem is recently the Active User List hasnt been working properly and there has been a major memory leak somehere, I suspect its the global.asa as I have checked all other files for open connections etc.
Below is the global.asa - can anyone see anything bad? So far I have removed all the lines that set the usserArry back to "" - is this a bad thing?
I have removed certain portions for security.
<script language="vbscript" runat="server">
Sub Application_OnStart
Application("Dataconn") = "DSN=(mydsnhere)"
Application("Active") = 0
Dim usersArray()
ReDim usersArray(9, 11) '8 Columns, 10 Rows'
Dim maxUsers
maxUsers = -1
Application("usersArray") = usersArray
Application("maxUsers") = maxUsers
Application("Home") = "default.asp" '09.09.2003 ' add the default page of the main site
Application("Test") = "" '09.09.2003
End Sub
Sub Application_OnEnd
End Sub
Sub Session_OnStart
Session.Timeout = 20
Session("Start") = Now
Application("Dataconn") = "DSN=(mydsnhere)"
'***************************************************'
' Create a session identity in usersArray'
'***************************************************'
Dim usersArray, maxUsers
Application.Lock
'### 09.09.2003
AITfname= Request.Cookies("FirstName")
AITsname=Request.Cookies("SurName")
AITfname = trim(AITfname + " " + AITsname)
AITpwd=Request.Cookies("AITPWD")
if len(AITfname) > 0 and len(AITpwd) > 0 then
strTemppath= request.ServerVariables("path_info")
Application("Test") = strTemppath
if instr(1,ucase(strTemppath),"FORUM1") > 0 then
strPath = "connect.asp?Name=" + AITfname + "&Password=" + AITpwd + "&Indic=G&Test=1"
else
strPath = "forum1\connect.asp?Name=" + AITfname + "&Password=" + AITpwd + "&Indic=G&Test=2"
end if
' response.redirect strPath
end if
'#### 09.09.2003
usersArray = Application("usersArray")
maxUsers = Application("maxUsers")
If maxUsers >= UBound(usersArray, 2) Then
ReDim Preserve usersArray(9, maxUsers + 11) 'Add an additional 10 rows'
End If
If Request.Cookies("Surname")<>"" Then
Dim aArray
For aArray = 0 to UBound(usersArray, 2) 'Check if returning (before timeout) has removed name from array'
If usersArray(7, aArray) = Request.Cookies("NewID")("ID") Then
Application("usersArray") = usersArray
Application("maxUsers") = maxUsers
Application.Unlock
Exit Sub
End If
Next
maxUsers = maxUsers + 1 'Add to the Array if Cookies exist but has timed out since'
usersArray(0, maxUsers) = Session.SessionID
usersArray(1, maxUsers) = Request.Cookies("FirstName") & " " & Request.Cookies("SurName")
usersArray(2, maxUsers) = Request.Cookies("Service")
usersArray(3, maxUsers) = Request.Cookies("Regiment")
usersArray(4, maxUsers) = Request.Cookies("Rank")
usersArray(5, maxUsers) = Request.Cookies("YearSignedUp")
usersArray(6, maxUsers) = Request.Cookies("YearLeft")
usersArray(7, maxUsers) = Request.Cookies("NewID")("ID")
usersArray(8, maxUsers) = Request.Cookies("StartDate")
usersArray(9, maxUsers) = Request.Cookies("OldPhoto")
Application("Active") = Application("Active") + 1
Else 'If no Cookies are stored on the user''s computer, just add them to the array as Guest'
maxUsers = maxUsers + 1
usersArray(0, maxUsers) = Session.SessionID
usersArray(1, maxUsers) = "Guest"
usersArray(2, maxUsers) = "Unknown"
usersArray(3, maxUsers) = "Unknown"
usersArray(4, maxUsers) = "Unknown"
usersArray(5, maxUsers) = "xxxx"
usersArray(6, maxUsers) = "xxxx"
usersArray(7, maxUsers) = "Unknown"
usersArray(8, maxUsers) = "Guest"
usersArray(9, maxUsers)=""
Application("Active") = Application("Active") + 1
End If
Application("usersArray") = usersArray
Application("maxUsers") = maxUsers
Application.Unlock
End Sub 'Session On_Start'
'***************************************************'
' End session identity'
'***************************************************'
'***************************************************'
' Remove user from the Application Array'
'***************************************************'
Sub Session_OnEnd
Dim iCycle
Application.Lock
usersArray = Application("usersArray")
maxUsers = Application("maxUsers")
For iCycle = 0 to UBound(usersArray, 2)
If usersArray(0, iCycle) = Session.SessionID Then
' usersArray(0, iCycle) = ""
' usersArray(1, iCycle) = ""
' usersArray(2, iCycle) = ""
' usersArray(3, iCycle) = ""
' usersArray(4, iCycle) = ""
' usersArray(5, iCycle) = ""
' usersArray(6, iCycle) = ""
' usersArray(7, iCycle) = ""
' usersArray(8, iCycle) = ""
' usersArray(9, iCycle) = ""
Dim jCycle
For jCycle = iCycle to (UBound(usersArray, 2) - 1)
If usersArray(0, jCycle + 1) = "" Then Exit For
usersArray(0, jCycle) = usersArray(0, jCycle + 1)
usersArray(1, jCycle) = usersArray(1, jCycle + 1)
usersArray(2, jCycle) = usersArray(2, jCycle + 1)
usersArray(3, jCycle) = usersArray(3, jCycle + 1)
usersArray(4, jCycle) = usersArray(4, jCycle + 1)
usersArray(5, jCycle) = usersArray(5, jCycle + 1)
usersArray(6, jCycle) = usersArray(6, jCycle + 1)
usersArray(7, jCycle) = usersArray(7, jCycle + 1)
usersArray(8, jCycle) = usersArray(8, jCycle + 1)
usersArray(9, jCycle) = usersArray(9, jCycle + 1)
usersArray(0, jCycle + 1) = ""
usersArray(1, jCycle + 1) = ""
usersArray(2, jCycle + 1) = ""
usersArray(3, jCycle + 1) = ""
usersArray(4, jCycle + 1) = ""
usersArray(5, jCycle + 1) = ""
usersArray(6, jCycle + 1) = ""
usersArray(7, jCycle + 1) = ""
usersArray(8, jCycle + 1) = ""
usersArray(9, jCycle + 1) = ""
Next
maxUsers = maxUsers - 1
Application("Active") = Application("Active") - 1
Exit For
End If
Next
Application("usersArray") = usersArray
Application("maxUsers") = maxUsers
Application.Unlock
End Sub 'Session On_End'
'***************************************************'
' End Remove user'
'***************************************************'
</script>