Solved: Microsoft OLE DB Provider for SQL Server error '80040e14'

what is the value of p_strSQL? and is ObjRS.Open p_strSQL, conn line 438?

ASKER

<%
' Function.asp
' version 1.3
' December 6, 2004

' ####################### All Functions and Subs After this line ########################

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' This Sub makes sure that this page is not cached.
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Sub DontCache
response.expires = -1440
response.expiresabsolute = Now() - 1
response.addHeader "pragma","no-cache"
response.addHeader "cache-control","private"
End Sub

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' This Sub displays the form and the teams
' This sub also calls the DisplaySelectTeams sub
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Sub WriteSelectTeamPage
DIV = Request("DIV")
response.write "<form name=""MyForm"" Method=""POST"" action=""" & FindFileName & """>" & VbCrLf

response.write "<table width=""90%"">" & VbCrLf
response.write "<tr><th align=""left""><nobr>Please Type the Age Group:</nobr></th>" &_
"<td><input type=""text"" name=""DIV"" value=""" & DIV & """>"

If DIV = "" then
response.write " Type ""U14"" <input type=""submit"" value=""Submit"" name=""B1""></td></tr>" & VbCrLf
       response.write "</table>" & VbCrLf
       response.write "<p> </p>" & VbCrLf
else
response.write "</td></tr>" & VbCrLf

       response.write "<tr><th align=""left"">Start Season</th><td><input type=""text"" name=""StartSeason"" value=""" & StartSeason & """></td></tr>" & VbCrLf
       response.write "<tr><th align=""left"">End Season</th><td><input type=""text"" name=""EndSeason"" value=""" & EndSeason & """></td></tr>" & VbCrLf
       response.write "<tr><th align=""left"">Week Days</th><td><input type=""text"" name=""WeekDays"" value=""" & WeekDays & """></td></tr>" & VbCrLf
       response.write "<tr><th align=""left"">NoGamesOnTheseDates</th><td><input type=""text"" name=""NoGamesOnTheseDates"" value=""" & NoGamesOnTheseDates &_
                           """></td></tr>" & VbCrLf
       response.write "<tr><th align=""left"">ALLDates</th><td><input type=""text"" name=""ALLDates"" value=""" & ALLDates & """></td></tr>" & VbCrLf

If request("StartSeason") = "" then
       response.write "<tr><td colspan=2><input type=""submit"" value=""Submit"" name=""B1""></td></tr>" & VbCrLf
       response.write "</table>" & VbCrLf
       response.write "<p> </p>" & VbCrLf
       else
       response.write "</table>" & VbCrLf
       response.write "<p> </p>" & VbCrLf
            call DisplaySelectTeams("SELECT * FROM springgirls WHERE age ='" & DIV & "'")
       end if
end if
response.write "</form> " & VbCrLf
end Sub

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' This Sub lets you choose the teams you want to schedule games for.
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Sub DisplaySelectTeams(strSQL)
Set RS = LoadRSFromDB(strSQL)

If not RS.EOF then
response.write "<table width=""90%"">"

response.write "<tr>" & VbCrLf
response.write "<th align=left>Select Team</th>" & VbCrLf
response.write "<th>Min Games</th>" & VbCrLf
response.write "<th>Max Games</th>" & VbCrLf
response.write "<th>Banned Dates</th>" & VbCrLf
response.write "</tr>" & VbCrLf

do until rs.EOF
response.write "<tr>" & VbCrLf
            TEAMSID = Trim(Request("TEAMSID"))
            If TeamsID <> "" then
                  If Instr(TeamsID, RS("ID")) > 0 then
                        strChecked = " checked "
                  else
                        strChecked = ""
                  end if
            else
                  strChecked = ""
            end if

response.write "<td align=left><input type=""checkbox"" name=""TEAMSID"" value=""" & RS("ID") & """ " & strChecked & "> " &_
"<input type=""text"" name=""TeamName" & RS("ID") & """ value="""& RS("TeamName") &""" readonly></td>" & VbCrLf
Dim MinGames, MaxGames
If request("MinGames" & RS("ID"))<> "" then
MinGames = request("MinGames" & RS("ID"))
else
MinGames = 10
end if

If request("Maxgames" & RS("ID"))<> "" then
Maxgames = request("Maxgames" & RS("ID"))
else
Maxgames = 10
end if

response.write "<td align=center> " & HTMLSelectBox("MinGames" & RS("ID"), "0,1,2,3,4,5,6,7,8,9,10", MinGames) &"</td>" & VbCrLf
response.write "<td align=center> " & HTMLSelectBox("MAXGames" & RS("ID"), "0,1,2,3,4,5,6,7,8,9,10", MaxGames) &"</td>" & VbCrLf
response.write "<td align=center><input type=""text"" name=""BANNEDDATES" & RS("ID") & """ value=""" &_
Trim(RS("option1") & " " & RS("option2") & " " & RS("option3") & " " & RS("option4")) & """></td>" & VbCrLf
response.write "</tr>" & VbCrLf
rs.movenext
loop
response.write "<td colspan=4><input type=""submit"" value=""Submit"" name=""B1""></td>" & VbCrLf
response.write "</table>" & VbCrLf
end if
End Sub

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' This function tries to Schedule the games
' This Function calls the following Functions
' - ScheduleTheGames
' - RandomizedArray
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Function ScheduleGame

TEAMSID = Request("TEAMSID")
If TEAMSID = "" then Exit Function
Dim ArrTeamsID
arrTeamsID = split(TeamsID & ",", ",")
Redim arrTeams(Ubound(arrTeamsID)-1,7)

for x=0 to Ubound(arrTeamsID)-1
If (Trim(arrTeamsID(x)) <> "") and (CInt(Request("MAXGames" & Trim(arrTeamsID(x)))) > 0) then
arrTeams(x,0) = Trim(arrTeamsID(x)) ' ID
arrTeams(x,1) = Request("TeamName" & Trim(arrTeamsID(x))) ' TeamName
arrTeams(x,2) = Request("BANNEDDATES" & Trim(arrTeamsID(x))) ' Banned Dates for the Team
arrTeams(x,3) = Request("MinGames" & Trim(arrTeamsID(x))) ' MinGames
arrTeams(x,4) = Request("MAXGames" & Trim(arrTeamsID(x))) ' MaxGames
arrTeams(x,5) = "1" ' Scheduled Games
arrTeams(x,6) = "0" ' Home Game
arrTeams(x,7) = "0" ' Road Game

if CInt(arrTeams(x,4)) < Cint(arrTeams(x,3)) then
' If MaxGames is less than MinGames, MaxGames = MinGames
arrTeams(x,4) = arrTeams(x,3)
end if
end if
next

Dim arrMatches()
ReDim arrMatches(1,100)

Dim CCur, MaxLoops
cCur = "0"
Maxloops = "10"
for zCur = 0 to MaxLoops
for aCur = 0 to Ubound(arrTeams,1)
for bCur = aCur to Ubound(arrTeams,1)
If arrTeams(aCur,0) <> arrTeams(bCur,0) then
if (CInt(arrTeams(aCur,5)) <= CInt(arrTeams(aCur,4))) AND (CInt(arrTeams(bCur,5)) <= CInt(arrTeams(bCur,4))) then
if (arrTeams(aCur,6)-arrTeams(aCur,7)) > (arrTeams(bCur,6)-arrTeams(bCur,7)) then

arrMatches(0,cCur) = arrTeams(bCur,1)
arrMatches(1,cCur) = arrTeams(aCur,1)

arrTeams(aCur,7) = arrTeams(aCur,7) + 1
arrTeams(bCur,6) = arrTeams(bCur,6) + 1
else

arrMatches(0,cCur) = arrTeams(aCur,1)
arrMatches(1,cCur) = arrTeams(bCur,1)

arrTeams(aCur,6) = arrTeams(aCur,6) + 1
arrTeams(bCur,7) = arrTeams(bCur,7) + 1

end if

arrTeams(aCur,5) = arrTeams(aCur,5) + 1
arrTeams(bCur,5) = arrTeams(bCur,5) + 1
cCur = cCur + 1
else
exit for
end if
end if
next
next
next

ReDim preserve arrMatches(1,cCur-1)

Dim arrMatch
arrMatch = RandomizedArray(SwapRowsCols(arrMatches))

response.write "<br><br><table width=""90%"">"
response.write "<tr><th>ID</th><th>TeamName</th><th>MinGames</th><th>MaxGames</th>" &_
"<th>Total_Scheduled</th><th>HomeGames</th><th>RoadGames</th><th>Comment</th></tr>"
for dCur = 0 to Ubound(arrTeams,1)
response.write "<tr>"
response.write "<td align=center>" & arrTeams(dCur,0) & "</td>" ' ID
response.write "<td align=center>" & arrTeams(dCur,1) & "</td>" ' TeamNames
response.write "<td align=center>" & arrTeams(dCur,3) & "</td>" ' MinGames
response.write "<td align=center>" & arrTeams(dCur,4) & "</td>" ' MaxGames
response.write "<td align=center>" & arrTeams(dCur,5)-1 & "</td>" ' Scheduled Games
response.write "<td align=center>" & arrTeams(dCur,6) & "</td>" ' HomeGames
response.write "<td align=center>" & arrTeams(dCur,7) & "</td>" ' RoadGames

if Cint(arrTeams(dCur,5))-1 < Cint(arrTeams(dCur,3)) then
response.write "<td align=center><nobr>SchGames < MinGames</nobr></td>"
elseif Cint(arrTeams(dCur,3)) <= Cint(arrTeams(dCur,5))-1 <= Cint(arrTeams(dCur,4)) then
response.write "<td align=center><nobr>Min < SchGames < Max</nobr></td>"
end if

response.write "</tr>"
next
response.write "</table>" & VbCrLf

response.write ScheduleTheGames(arrMatch, arrTeams)

End Function

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' This Function Finds the exact Dates of the Games
' This Function is called within ScheduleGame Function
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Function ScheduleTheGames(arrInput, arrTeams)

ReDim arrOutput(Ubound(arrInput,1),2)
Dim ee ' integer for looping

for ee=0 to Ubound(arrInput,1)

dim HomeBannedDates, VisitBannedDates, HomeIndex, VisitIndex, NextDate

HomeBannedDates = FindBannedDates(arrInput(ee,0), arrTeams)
VisitBannedDates= FindBannedDates(arrInput(ee,1), arrTeams)

HomeIndex = mid(HomeBannedDates, Instr(HomeBannedDates, "|")+1)
VisitIndex= mid(VisitBannedDates, Instr(VisitBannedDates, "|")+1)

HomeBannedDates = mid(HomeBannedDates, 1, Instr(HomeBannedDates, "|")-1)
VisitBannedDates= mid(VisitBannedDates, 1, Instr(VisitBannedDates, "|")-1)


       BreakoutCounter = 0
       NextTime = "CANT_SCHEDULE"
       Do while NextTime = "CANT_SCHEDULE"
'              NextTime = "CANT_SCHEDULE"
            NextDate = ""
            NextDate = FindNextDate(AllDates, NoGamesOnTheseDates, HomeBannedDates, VisitBannedDates)
            NextTime = FindNextTime(NextDate, "9:00:00 AM", "5:00:00 PM")
            HomeBannedDates = HomeBannedDates & " " & NextDate
            VisitBannedDates= VisitBannedDates& " " & NextDate
            arrTeams(HomeIndex,2) = arrTeams(HomeIndex,2) & " " & NextDate
            arrTeams(VisitIndex,2) = arrTeams(VisitIndex,2) & " " & NextDate
            BreakoutCounter = BreakoutCounter +1
            If BreakoutCounter > 20 then exit do
       Loop

'        Response.write "||" & NextDate & " " & NextTime & "|<br>"
'        Response.write "||" & NextTime & "<< Scheduled Time|<br>"

' NoGamesOnTheseDates = NoGamesOnTheseDates & " " & Month(NextTime) & "/" & Day(NextTime) & "/" & Year(NextTime)
arrTeams(HomeIndex,2) = arrTeams(HomeIndex,2) & " " & Month(NextTime) & "/" & Day(NextTime) & "/" & Year(NextTime)
arrTeams(VisitIndex,2) = arrTeams(VisitIndex,2) & " " & Month(NextTime) & "/" & Day(NextTime) & "/" & Year(NextTime)

arrOutput(ee,0) = arrInput(ee,0)
arrOutput(ee,1) = arrInput(ee,1)
' arrOutput(ee,2) = NextDate & " " & NextTime
arrOutput(ee,2) = NextTime

       response.write "GoToNext<br><br>"
next
'ScheduleTheGames = arrOutput

Response.write "<p> </p>"
Response.write "<p><b>Scheduled Games:</b></p>" & VbCrLf

Dim GameIDs

for gg=0 to Ubound(arrOutput,1)
Dim SQL
GameTime = "3:00 PM"
SQL = "Insert into databasenewschedule (Div, GameDate, HomeID, VisitID) VALUES ('" & Div & "', '" & arrOutput(gg,2) & "', '" & arrOutput(gg,0) & "', '" & _
             arrOutput(gg,1) & "');"

'      response.write SQL & "<br>"
      GameIDs = GameIDs & InsertRecord(SQL) & ", "

next

GameIDs = mid(GameIDs,1,len(GameIDs)-2)
SQL1 = "Select Game, Div, GameDate, HomeID, VisitID from databasenewschedule where GAME in (" & GameIDs & ") order by Gamedate ASC"
Set RS1 = LoadRSFromDB(SQL1)
call WriteTableFromRS(RS1)

End Function

Function TestDate(strHomeID, strVisitID, strDate)
'      response.write strHomeID & "|" & strVisitID & "<<InputDates<br>"
      SQLTestDt = "Select GameDate from databasenewschedule where (HOMEID = '" & strHomeID & "' OR VisitID = '" & strHomeID & "' OR HOMEID = '" & strVisitID & "'" &_
                  " OR VisitID = '" & strVisitID & "') AND GameDate = '" & strDate & "';"
      set RSTestDt = LoadRSFromDB(SQLTestDt)
      If RSTestDt.EOF then
            strTestDate = "CAN_SCHEDULE"
      else
            strTestDate = "DATE_FOUND"
      end if
      TestDate = strTestDate
end Function

Function FindNextTime(dtDate, StartTime, EndTime)
      dim RSTime
      dim SchedulableTime, SQLNextTime
      SQLNextTime = "Select GameDate from databasenewschedule where GameDate > '" & dtDate & " 00:00:00 AM' and GameDate < '" & dateadd("d",1,dtDate) & " 00:00:00 AM'"
      SQLNextTime = SQLNextTime & " Order by GameDate DESC"
      response.write SQLNextTime & "<br>"
      Set RSTime = LoadRSFromDB(SQLNextTime)

      If RSTime.EOF then
            response.write "No records Found<br><br>"
            strOuput = dtDate & " " & StartTime
      else
            response.write "Some records Found<br>"
            response.write RSTime("GameDate") & "<br>"
            SchedulableTime = DateAdd("h",2,RSTime("GameDate"))
            response.write SchedulableTime & "<br>"
            If DateDiff("n", SchedulableTime, cDate(dtDate & " " & EndTime)) < 0 then
                  response.write "Cant Schedule<br><br>"
                  strOuput = "CANT_SCHEDULE"
            else
                  response.write "Can Schedule<br>"
                  strOuput = SchedulableTime
            end if
      end if

      response.write "FindNextTime:" & strOuput & "|<br>"
      FindNextTime = strOuput
End Function

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' This Function calculates all the dates on which the games are possible
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Function FindWeeklyDates(StartDate, EndDate, WeekDays, RecurFreq)
NumberDays = DateDiff("d",StartDate,EndDate)
for y= StartDate to DateAdd("d",NumberDays,StartDate)
for x= y to DateAdd("d",6,y)
if DateDiff("d",x,EndDate) < 0 then exit for end if
if Instr(Weekdays,weekday(x))> 0 then
strOuput = strOuput & x & " "
end if
i = i+1
next
y = DateAdd("d",-1,x)
y = DateAdd("d",(RecurFreq-1)*7-1,x)
if DateDiff("d",y,EndDate) < 0 then exit for end if
next
FindWeeklyDates = Trim(strOuput)
End Function

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' This Function Finds the Banned Dates of each of the teams
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Function FindBannedDates(TeamId, arrTeams)
TeamDates = FindTeamGameDates(TeamID)
for ff=0 to Ubound(arrTeams,1)
If arrTeams(ff,1) = TeamId then
strBannedDates = TeamDates & " " & arrTeams(ff,2) & "|" & ff
exit for
end if
next
' response.write "strBannedDates " & TeamId & ": " & strBannedDates & "<br>"
FindBannedDates = strBannedDates
end Function

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' This Function Finds the next convenient day for both the teams
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Function FindNextDate(AllDates, AllBannedDates, HomeDates, VisitDates)
arrAllDates = split(AllDates & " "," ")
for each xDate in arrAllDates
if (Instr(AllBannedDates,xDate)= 0) AND (Instr(HomeDates,xDate)= 0) AND (Instr(VisitDates,xDate)= 0) then
strOuput = Trim(xDate)
exit for
end if
next
      If strOuput="" then strOuput="9/9/1999"
FindNextDate = strOuput
End Function

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' This Function Finds all the dates the team has games on.
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function FindTeamGameDates(TeamID)
      SQLFind = "Select GameDate from databasenewschedule where HOMEID = '" & TeamID & "' OR VisitID = '" & TeamID & "';"
      set RSFind = LoadRSFromDB(SQLFind)
      If not RSFind.EOF then
            do until RSFind.EOF
                  strGameDate = RSFind("GameDate")
                  If Instr(strFindTeamGameDates, Month(strGameDate) & "/" & Day(strGameDate) & "/" & Year(strGameDate))= 0 then
                        strFindTeamGameDates = strFindTeamGameDates & " " & Month(strGameDate) & "/" & Day(strGameDate) & "/" & Year(strGameDate)
                  end if
                  RSFind.Movenext
            loop
      end if
      FindTeamGameDates = strFindTeamGameDates
end Function

' -----------------------------------------------------------------------------------------------
' This function returns a recordset when you supply it the SQL statement
' -----------------------------------------------------------------------------------------------

Function LoadRSFromDB(p_strSQL)
dim ObjRS, conn

if not IsObject("conn") then
set conn=Server.CreateObject("ADODB.Connection")
conn.ConnectionTimeout = 15
conn.CommandTimeout = 10
conn.Mode = 3 'adModeReadWrite
if conn.state = 0 then
conn.Open strConnectString
end if
end if

set ObjRS= Server.CreateObject("ADODB.recordset")
ObjRS.Open p_strSQL, conn

if Err <> 0 then
Err.Raise Err.Number, "ADOHelper: RunSQLReturnRS", Err.Description
end if

' Disconnect the recordsets and cleanup
Set LoadRSFromDB = ObjRS

' ObjRS.close
' conn.close
Set ObjRS = Nothing
Set conn= Nothing
End Function

Function RunSQL(p_strSQL)
' Create the ADO objects
if not IsObject("conn") then
set conn=Server.CreateObject("ADODB.Connection")
conn.ConnectionTimeout = 15
conn.CommandTimeout = 10
conn.Mode = 3 'adModeReadWrite
if conn.state = 0 then
conn.Open strConnectString
end if
end if

       conn.Execute(p_strSQL)

if Err <> 0 then
Err.Raise Err.Number, "ADOHelper: RunSQL", Err.Description
end if

' Cleanup
Set conn = Nothing
End Function

Function InsertRecord(strSQLx)
dim conn, strSQL1, ThisID, objRS1

if not IsObject("conn") then
set conn=Server.CreateObject("ADODB.Connection")
conn.ConnectionTimeout = 15
conn.CommandTimeout = 10
conn.Mode = 3 'adModeReadWrite
if conn.state = 0 then
conn.Open strConnectString
end if
end if

' response.write "<p>" & strSQLx & "</p>"
conn.Execute(strSQLx)
strSQL1 = "SELECT @@IDENTITY AS ThisID;"

Set objRS1 = Conn.Execute(strSQL1)
ThisID = objRS1("ThisID")

Set ObjRS1 = Nothing
conn.close
Set conn = Nothing

If Err.number = 0 Then
InsertRecord = thisID
End If
End Function

Sub WriteTableFromRS(RSobj)

i = 0
'Display recordSet - write Headers
      response.write "<table width=""100%""><tr>"
      for each x in RSobj.Fields
            response.write "<th>" & x.name & "</th>"
            i = i + 1
      next
      response.write "</tr>"

'Display recordSet - Dislplay Data
      If not RSobj.EOF then
            do until RSobj.EOF
                  response.write "<tr>"
                  for each y in RSobj.Fields
                        response.write "<td align=center>" & y.value & "</td>"
                  next
                  response.write "</tr>"
              RSobj.movenext
            loop
      else
            response.write "<tr><td colspan=" & i & ">No Results Found</td></tr>"
      end if

      response.write "</table>"

end Sub

' -----------------------------------------------------------------------------------------------
' This function Writes the HTML code for a Select Box if you supply it the following attributes
' SelName = Name of the Select Box
' strValues = Comma separated option values
' SelValue = The value that needs to be selected
' -----------------------------------------------------------------------------------------------

Function HTMLSelectBox(SelName, strValues, SelValue)
strOutput = "<select name=""" & SelName & """>" & VbCrLf
arrValues = split(strValues,",")
for SelectCounter = 0 to Ubound(arrValues)
strOutput = strOutput & "<option value=""" & trim(arrValues(SelectCounter)) & """"
If lcase(trim(arrValues(SelectCounter))) = lcase(SelValue) then
strOutput = strOutput & " selected "
end if
strOutput = strOutput & " >" & trim(arrValues(SelectCounter)) & "</option>" & VbCrLf
next
strOutput = strOutput & "</select>" & VbCrLf
HTMLSelectBox = strOutput
end Function

' -----------------------------------------------------------------------------------------------
' This function finds the name of the file in which this code is executed.
' -----------------------------------------------------------------------------------------------

Function FindFileName
FileName = lcase(Request.ServerVariables("PATH_INFO"))
dim arrFilename
arrFilename = split(FileName,"/")
FindFileName = arrFileName(Ubound(arrFileName))
End Function

' -----------------------------------------------------------------------------------------------
' This function swaps the rows to colums in an array and returns a new array
' -----------------------------------------------------------------------------------------------

function SwapRowsCols(inputArr)

Dim cc, dd ' Integers for Looping
Dim outputArr()
ReDim outputArr(Ubound(inputArr,2),Ubound(inputArr,1))

For cc = LBound(inputArr,1) To UBound(inputArr,1)
for dd = LBound(inputArr,2) To UBound(inputArr,2)
outputArr(dd,cc) = inputArr(cc,dd)
next
Next

SwapRowsCols = outputArr
end function

' -----------------------------------------------------------------------------------------------------
' If you supply this function an array, this function will randomize it and return it back as an array
' -----------------------------------------------------------------------------------------------------

function RandomizedArray(inputArray)

Dim arrSequencer ' Array to Hold Random Sequence
Dim iArraySize ' Size of Data Array
Dim cCur, dCur ' Integer for Looping

ReDim outputArray(Ubound(inputArray,1),Ubound(inputArray,2))

' Determine the size of the data array's (data) dimension.
iArraySize = (Ubound(inputArray, 1)) +1

' Get an array of numbers 0 to array size randomly sequenced.
arrSequencer = GetRandomizedSequencerArray(iArraySize)

For cCur = LBound(arrSequencer) To UBound(arrSequencer)
for dCur = LBound(inputArray,2) To UBound(inputArray,2)
outputArray(cCur,dCur) = inputArray(arrSequencer(cCur),dCur)
next
Next

RandomizedArray = outputArray
end function

' -----------------------------------------------------------------------------------------------------
' This function generates a random sequence and is used in the RandomizedArray function.
' -----------------------------------------------------------------------------------------------------

Function GetRandomizedSequencerArray(iArraySize)
Dim arrTemp()
Dim I
Dim iLowerBound, iUpperBound
Dim iRndNumber
Dim iTemp

' Set array size
ReDim arrTemp(iArraySize - 1)

' Init randomizer
Randomize

' Get bounds into local vars for speed
iLowerBound = LBound(arrTemp)
iUpperBound = UBound(arrTemp)

' Insert initial values
For I = iLowerBound To iUpperBound
arrTemp(I) = I
Next

' Loop through the array once, swapping each value
' with another in a random location within the array.
For I = iLowerBound to iUpperBound
' Generate random # in range
iRndNumber = Int(Rnd * (iUpperBound - iLowerBound + 1))

' Swap Ith element with iRndNumberth element
iTemp = arrTemp(I)
arrTemp(I) = arrTemp(iRndNumber)
arrTemp(iRndNumber) = iTemp
Next 'I

' Return our array
GetRandomizedSequencerArray = arrTemp
End Function

'==-----------------------------------------------------------==
'== This entire piece of code was shamelessly stolen from ==
'== the 4 Guys From Rolla WebWeekly newsletter, translated ==
'== to VBScript and changed into server-side ASP code. ==
'== Every effort has been made to keep comments intact. ==
'== ==
'== This version sorts 2-dimensional arrays on a single field ==
'==-----------------------------------------------------------==

Sub SwapRows(ary,row1,row2)
'== This proc swaps two rows of an array
Dim x,tempvar
For x = 0 to Ubound(ary,2)
tempvar = ary(row1,x)
ary(row1,x) = ary(row2,x)
ary(row2,x) = tempvar
Next
End Sub 'SwapRows

Sub QuickSort(vec,loBound,hiBound,SortField)

'==--------------------------------------------------------==
'== Sort a 2 dimensional array on SortField ==
'== ==
'== This procedure is adapted from the algorithm given in: ==
'== ~ Data Abstractions & Structures using C++ by ~ ==
'== ~ Mark Headington and David Riley, pg. 586 ~ ==
'== Quicksort is the fastest array sorting routine for ==
'== unordered arrays. Its big O is n log n ==
'== ==
'== Parameters: ==
'== vec - array to be sorted ==
'== SortField - The field to sort on (2nd dimension value) ==
'== loBound and hiBound are simply the upper and lower ==
'== bounds of the array's 1st dimension. It's probably ==
'== easiest to use the LBound and UBound functions to ==
'== set these. ==
'==--------------------------------------------------------==

Dim pivot(),loSwap,hiSwap,temp,counter
Redim pivot (Ubound(vec,2))

'== Two items to sort
if hiBound - loBound = 1 then
if vec(loBound,SortField) > vec(hiBound,SortField) then Call SwapRows(vec,hiBound,loBound)
End If

'== Three or more items to sort

For counter = 0 to Ubound(vec,2)
pivot(counter) = vec(int((loBound + hiBound) / 2),counter)
vec(int((loBound + hiBound) / 2),counter) = vec(loBound,counter)
vec(loBound,counter) = pivot(counter)
Next

loSwap = loBound + 1
hiSwap = hiBound

do
'== Find the right loSwap
while loSwap < hiSwap and vec(loSwap,SortField) <= pivot(SortField)
loSwap = loSwap + 1
wend
'== Find the right hiSwap
while vec(hiSwap,SortField) > pivot(SortField)
hiSwap = hiSwap - 1
wend
'== Swap values if loSwap is less then hiSwap
if loSwap < hiSwap then Call SwapRows(vec,loSwap,hiSwap)

loop while loSwap < hiSwap

For counter = 0 to Ubound(vec,2)
vec(loBound,counter) = vec(hiSwap,counter)
vec(hiSwap,counter) = pivot(counter)
Next

'== Recursively call function .. the beauty of Quicksort
'== 2 or more items in first section
if loBound < (hiSwap - 1) then Call QuickSort(vec,loBound,hiSwap-1,SortField)
'== 2 or more items in second section
if hiSwap + 1 < hibound then Call QuickSort(vec,hiSwap+1,hiBound,SortField)

End Sub 'QuickSort

%>

kiddanger

I do mine differently but it probably wants this:
ObjRS.Open p_strSQL, conn, 3, 3

gianitoo

ASKER

you know what it was, it did not like a team named 92' or 92/93. best wat was to add numbers instead