ASP/VBScript timeout issue

[YoelBenYossef]

Hi there,
I'm working on some legacy code written in VBScript in an ASP page. It works fine with IIS in Windows XP, and Windows 2000, but on Server 2003, it just times out. The error that I get is:

Error Type:
Active Server Pages, ASP 0113 (0x80004005)
The maximum amount of time for a script to execute was exceeded. You can change this limit by specifying a new value for the property Server.ScriptTimeout or by changing the value in the IIS administration tools.
/meetingsystem/defaulttestold.asp


Through Trial and error, I found that the error came from this part of the code:

Do Until RS.EOF OR count = 9
'Used to alternate colors between lines
If i = 1 then
i = i + 1
Response.Write "<TR bgcolor=#FFFFFF><TD><Font color=black><Center>" &"<font size=4 face=Arial>" &FormatDateTime(objtime,vbShortTime)& "</TD><TD><Font color=black size=4 face=Arial>&nbsp;" & objMeeting&"</TD><TD>" & "<Font color=black size=4 face=Arial>" & objRoom & "</TD</TR>"
else
i = i - 1
Response.Write "<TR bgcolor=#3E797D><TD><Center><Font color=F5F5F5 size=4 face=Arial>" & FormatDateTime(objtime,vbShortTime)& "</TD><TD><Font color=F5F5F5 size=4 face=Arial>" & objMeeting&"</TD><TD><Font color=F5F5F5 size=4 face=Arial>"&objRoom&"</TD</TR>"
End IF
RS.MoveNext
count = count + 1
Loop

I'd appreciate help immensly.
Thanks
Eric

 

[guitarzan]

How many records are in RS?

What value is "count" initialized to before this code executes?

 

[YoelBenYossef]

Count is initialised to 1.
There usually are about 20 records, but it should be able to handle 0 records.

Here's the program in it's entirety:

<%@ LANGUAGE="VBSCRIPT" %>
<%OPTION EXPLICIT%>
<%Response.Expires = -1
Dim Parms

Sub ListEntries
Dim DBConn
Dim RS
Dim SQLString
Dim objTime
Dim objMeeting
Dim objRoom
Dim objDate
Dim Color
Dim PString
Dim Count
Dim x
Dim i

'***** Skip Errors to ensure continuous cycle*****
on error resume next

' Connect to access database "C:\database\meeting.mdb" via ODBC
Set DBConn = Server.CreateObject ("ADODB.Connection")
DBConn.Open ("FileDSN=meeting.dsn")

Set RS = Server.CreateObject ("ADODB.Recordset")

SQLString = "SELECT Event.Time, Event.Meeting, Event.Room FROM Event as Event WHERE Event.Date LIKE " &_
chr(39)&date&chr(39) & " AND Event.Time > #" & GetExpTime() & "# ORDER BY Event.Time"

' Generate recordset from DB entries
RS.Open SQLString, DBConn
Set objTime = RS("Time")
Set objMeeting = RS("Meeting")
Set objRoom = RS("Room")

'Que up recordset based on page to be displayed
for x = 1 to (9*Request.QueryString("P"))
RS.MoveNext
next

i = 1
' Display records, and conplete the screen by adding blank lines
Do Until RS.EOF OR count >= 9
'Used to alternate colors between lines
If i = 1 then
i = i + 1
Response.Write "<TR bgcolor=#FFFFFF><TD><Font color=black><Center>" &"<font size=4 face=Arial>" &FormatDateTime(objtime,vbShortTime)& "</TD><TD><Font color=black size=4 face=Arial>&nbsp;" & objMeeting&"</TD><TD>" & "<Font color=black size=4 face=Arial>" & objRoom & "</TD</TR>"
else
i = i - 1
Response.Write "<TR bgcolor=#3E797D><TD><Center><Font color=F5F5F5 size=4 face=Arial>" & FormatDateTime(objtime,vbShortTime)& "</TD><TD><Font color=F5F5F5 size=4 face=Arial>" & objMeeting&"</TD><TD><Font color=F5F5F5 size=4 face=Arial>"&objRoom&"</TD</TR>"
End IF
RS.MoveNext
count = count + 1
Loop

'If a full page has been displayed set page # flag
If count = 9 then
Pstring = Request.QueryString("P")+1
parms = "?P=" & Pstring & "&F=" & Request.QueryString("F")

ELSE
If Not Request.QueryString ("F") = "true" then
parms = "?F=true"
End If
End IF
Do until count >= 9
If i = 1 then
color = "#FFFFFF"
i = i + 1
else
color = "#3E797D"
i = i - 1
End IF
Response.Write "<TR bgcolor="&chr(39)&color&chr(39)&"><TD>&nbsp</TD><TD>&nbsp</TD><TD>&nbsp</TD</TR>"
count = count + 1
Loop

Response.Write "</TABLE>"
RS.Close
DBConn.Close

End Sub


Function FormatTime(Time)
' Format time to display in "hh:mm (AM/PM)" format
Dim TimeLeft

'***** Skip Errors to ensure continuous cycle*****
on error resume next

TimeLeft = len(Time)- 6
FormatTime = left(Time,TimeLeft) & right(Time,3)
End Function

Function GetExpTime()
' Returns time for meetings to expire based on actual less 2 hours
Dim ExpHour
Dim ExpMin

'***** Skip Errors to ensure continuous cycle*****
on error resume next

ExpHour = Hour(now())-1
ExpMin = Minute(now())
GetExpTime = Exphour & ":" & ExpMin
End Function
Function DisplayDate()
' Translates Month and Weekday to display Date in appropriate language
Dim MyWeekDay
Dim MyMonth

'***** Skip Errors *****
on error resume next


If Request.QueryString ("F") = "true" then
MyWeekDay = weekday(now())
MyMonth = month(now())
Select case MyMonth
case 1
MyMonth = " Janvier"
case 2
MyMonth = " Février"
case 3
MyMonth = " Mars"
case 4
MyMonth = " Avril"
case 5
MyMonth = " Mai"
case 6
MyMonth = " Juin"
case 7
MyMonth = " Juillet"
case 8
MyMonth = " Août"
case 9
MyMonth = " Septembre"
case 10
MyMonth = " Octobre"
case 11
MyMonth = " Novembre"
case 12
MyMonth = " Décembre"
case else
MyMonth = " Boo!"
End Select
Select case MyWeekDay
case vbMonday
MyWeekDay = "Lundi, "
case vbTuesday
MyWeekDay = "Mardi, "
case vbWednesday
MyWeekDay = "Mercredi, "
case vbThursday
MyWeekDay = "Jeudi, "
case vbFriday
MyWeekDay = "Vendredi, "
case vbSaturday
MyWeekDay = "Samedi, "
case vbSunday
MyWeekDay = "Dimanche, "
case Else
MyWeekDay = "*"
End Select
DisplayDate = MyWeekDay & day(now()) & MyMonth & ", " & year(Now())
Else
DisplayDate = FormatdateTime(Now(), 1)
End IF
End Function
%>
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset= iso-8859-1">
<title>Meeting Display System</title>
</head>
<body background="background.jpg" text="#006699" link="#0000ff" vlink="#ff00ff" rightmargin=0>
<BR>
<TABLE>
<TR><TD width=100 valign=top><CENTER><IMG height=65 src="cummings3.jpg" width=75 onclick="openDB()"></CENTER></TD>
<TD width=320><CENTER><FONT face="Book Antiqua" color="#F3F49C" size = 6><I>
<OBJECT align=middle classid=clsid:59CCB4A0-727D-11CF-AC36-00AA00A47DD2
codeBase=ietimer.ocx#Version=4,70,0,1161
height=0 id=tmrMain type=application/x-oleobject width=0 VIEWASTEXT border="0">
<PARAM NAME="_ExtentX" VALUE="1323"><PARAM NAME="_ExtentY" VALUE="1323">
<PARAM NAME="Interval" VALUE="12000"><PARAM NAME="Enabled" VALUE="True"></OBJECT>
Maison Cummings House</I></FONT></CENTER></TD><TD><CENTER>
<FONT face="Book Antiqua" color="#F3F49C" size=3><%= DisplayDate() %></FONT><BR>
<FONT face="Book Antiqua" color="#F3F49C" size=5><CENTER><%= FormatDateTime(Now,vbShortTime)%></CENTER></FONT></CENTER></TD></TR></TABLE>
</TABLE>
<%'Displaya table headers in appropriate language
if Request.QueryString("F") = "" then
Response.Write "<TABLE border= 1 bordercolor=black><TR><TD><center>" &_
"<font size=5.5 color=black><B><U>Time</B></font></center></U></TD><td width=500>" &_
"<center><font size=5 color=black><B><U>Meeting</B></font></center></U></td>" &_
"<TD width=200><font size=5 color=black><B><U>Room</B></font><CENTER></CENTER></U></TD></TR>"
else
Response.Write "<TABLE border=1 bordercolor=black><TR><TD width=80><center>" &_
"<font size=5 color=black><b><U>Heure</b></font></center></U></TD><td width=500>" &_
"<center><font size=5 color=black><B><U>Réunion</B></font></center></U></td>" &_
"<TD width=200><font size=5 color=black><B><U>Salle</B></font><CENTER></CENTER></U></TD></TR>"
end if
if not hour(Now) > 23 and not hour(now) < 5 then Call ListEntries

%>
<script language="VBScript">
<!--

Sub tmrMain_Timer
' Action to by executed by timer control (tmrMain)
Location.HRef = ("./defaulttestold.asp<%=parms%>")
End Sub
Function openDB()
' Opens BD when logo is clicked
window.open ("\\cjahome\db\meeting.mdb")
End Function
-->
</script>
</body>
</html>

 

[guitarzan]

I don't see Count initialized to anything, at least not in the scope of ListEntries... not sure that's the problem though.

I would either remove the "on error resume next", or add code to check Err.Number for errors, and address them. Off the top of my head, if the block of code you suggested earlier as the cause of the problem IS actually causing the problem, it's likely that "RS.EOF" is never being triggered. Have a look at the errors, or throw some response.writes in to confirm the block of code causing the script timeout.

 

[tsuji]

Whatever the rest, these are incorrect.
[tt] [red]'[/red]Set objTime = RS("Time")
[red]'[/red]Set objMeeting = RS("Meeting")
[red]'[/red]Set objRoom = RS("Room")
objTime = RS("Time")
objMeeting = RS("Meeting")
objRoom = RS("Room")
[/tt]