Locate that
hard to find 80s song/Artist
|
 |
|
Click on a number on the left to view the top 10
We
have now compiled the overall top 10 of your individual
top 10s
This is instantly updated, so whoever submits a top
10 will be having a direct influence on this chart.
Click here to view this
chart.
<%
' *************************************************************************
' GLOBAL CONSTANTS
' *************************************************************************
Const adUseClient = 3
' indicates that client cursor engine should be used
Const adStateOpen = 1
' used to determine wheter a data connection is open
Const adInteger = 3
' ADO value for an Integer data type
Const adSmallInt = 2
' ADO value for a small Integer data type
Const adLongVarWChar = 203
' ADO value for a Memo data type
Const adBoolean = 11
' ADO value for a Boolean data type
Const adVarWChar = 202
' ADO value for Variant character data type
Const adDate = 7
' ADO value for a Date data type
Const adCmdText = 1
' specifies that query is defined by .CommandText property
' *************************************************************************
' GLOBAL VARIABLES
' *************************************************************************
Dim gobjDataConn
' connection with database
' *************************************************************************
' MAIN CODE
' *************************************************************************
On Error Resume Next
' ---------------------------------------------------------------------
' Get database connection
' ---------------------------------------------------------------------
If NOT GetDatabaseConnection Then
Response.Write ""
DisplayMessage "It was not possible to display the Top 10 list. " _
& "If this problem can not be resolved by refreshing the page " _
& "please try again later.", "80%"
Response.End
End If
' ---------------------------------------------------------------------
' If posting data, attempt to save new Top 10
' ---------------------------------------------------------------------
If Request.ServerVariables("REQUEST_METHOD") = "POST" then
If NOT SaveTop10 Then
DisplayMessage "It was not possible to save your Top 10. If " _
& "this problem can not be resolved by refreshing the page " _
& "please E-Mail me the details so that I can add them to the " _
& "site.", "95%"
End If
End If
' ---------------------------------------------------------------------
' Show Top 10 Headers
' ---------------------------------------------------------------------
ShowTop10Hdrs
' *************************************************************************
' SERVER PROCEDURES
' *************************************************************************
FUNCTION GetDatabaseConnection
' ---------------------------------------------------------------------
' DESCRIPTION OF ROUTINE
' ---------------------------------------------------------------------
' Purpose: To establish a connection with the data source
' Assumptions: None
' Effects: None
' Inputs: None
' Returns: True/False value identifying whether connection was
' successfully established.
' ---------------------------------------------------------------------
On Error Resume Next
' ---------------------------------------------------------------------
' Attempt to open connection with data source
' ---------------------------------------------------------------------
Set gobjDataConn = Server.CreateObject("ADODB.Connection")
gobjDataConn.Open "File name=" & server.MapPath("Pure80sPop.udl")
' ---------------------------------------------------------------------
' Check for database connection error
' ---------------------------------------------------------------------
If gobjDataConn.State = adStateOpen Then
GetDatabaseConnection = TRUE
Else
GetDataBaseConnection = FALSE
End If
END FUNCTION
' *************************************************************************
FUNCTION SaveTop10
' ---------------------------------------------------------------------
' DESCRIPTION OF ROUTINE
' ---------------------------------------------------------------------
' Purpose: To save a Top 10 form to a database.
' Assumptions: None
' Effects: None
' Inputs: None
' Returns: None
' ---------------------------------------------------------------------
On Error Resume Next
' ---------------------------------------------------------------------
' Declare variables
' ---------------------------------------------------------------------
Dim objItem
' used to enumerate forms collection
Dim intKey
' used to iterate control name with multiple values
Dim avarTopTen(10,3)
' array containing
Dim varShowEMail
' whether to show E-Mail address
Dim lngTop10Seqn
' Topo 10 Header number
Dim cmdInsTop10Hdr
' query to INSERT a Top 10 Header record
Dim cmdInsTop10Itm
' query to INSERT a Top 10 Item record
Dim cmdDelTop10
' query to DELETE a Top 10 chart
Dim lngRecordsAffected
' number of records affected by an action query
Dim blnErrorsOccurred
' identifies whether errors occurred updating database
Dim lngTxnLevel
' level of transaction. Should be 1 for open transaction
Dim strSQL
' query definition
' ---------------------------------------------------------------------
' Get Top 10 into an array
' ---------------------------------------------------------------------
For Each objItem In Request.Form
If Request.Form(objItem).Count > 1 Then
For intKey = 1 to Request.Form(objItem).Count
Select Case UCase(objItem)
Case "ARTIST"
avarTopTen(intKey-1, 0) = Request.Form(objItem)(intKey)
Case "SONG"
avarTopTen(intKey-1, 1) = Request.Form(objItem)(intKey)
Case "COMMENTS"
avarTopTen(intKey-1, 2) = Request.Form(objItem)(intKey)
End Select
Next
End If
Next
' ---------------------------------------------------------------------
' Define queries
' ---------------------------------------------------------------------
' Query to INSERT a Top 10 Header record
Set cmdInsTop10Hdr = Server.CreateObject("ADODB.Command")
With cmdInsTop10Hdr
' Set main Command properties
Set .ActiveConnection = gobjDataConn
.CommandType = adCmdText
.CommandText = "" _
& "INSERT INTO tblTop10Hdr " _
& "(TTH_SEQN, TTH_DATE_POSTED, TTH_NAME, TTH_LOCATION, " _
& "TTH_EMAIL, TTH_SHOW_EMAIL ) " _
& "VALUES (?,?,?,?,?,?)"
' Create parameters collection
.Parameters.Append .CreateParameter("TTH_SEQN", adInteger)
.Parameters.Append .CreateParameter("TTH_DATE_POSTED", adDate)
.Parameters.Append .CreateParameter("TTH_NAME", adVarWChar, ,50)
.Parameters.Append .CreateParameter("TTH_LOCATION", adVarWChar, ,50)
.Parameters.Append .CreateParameter("TTH_EMAIL", adVarWChar, ,50)
.Parameters.Append .CreateParameter("TTH_SHOW_EMAIL", adBoolean)
End With
' Query to INSERT a Top 10 Header record
Set cmdInsTop10Itm = Server.CreateObject("ADODB.Command")
With cmdInsTop10Itm
' Set main Command properties
Set .ActiveConnection = gobjDataConn
.CommandType = adCmdText
.CommandText = "" _
& "INSERT INTO tblTop10Itm " _
& "(TTI_HDR_SEQN, TTI_POSITION, TTI_ARTIST, TTI_SONG, " _
& "TTI_COMMENTS, TTI_SONG_KEY) " _
& "VALUES (?,?,?,?,?,?)"
' Create parameters collection
.Parameters.Append .CreateParameter("TTI_HDR_SEQN", adInteger)
.Parameters.Append .CreateParameter("TTI_POSITION", adSmallInt)
.Parameters.Append .CreateParameter("TTI_ARTIST", adVarWChar, ,50)
.Parameters.Append .CreateParameter("TTI_SONG", adVarWChar, ,50)
.Parameters.Append .CreateParameter("TTI_COMMENTS", adVarWChar, ,255)
.Parameters.Append .CreateParameter("TTI_SONG_KEY", adVarWChar, ,50)
End With
' ---------------------------------------------------------------------
' Evaluate values required by queries
' ---------------------------------------------------------------------
' Top 10 Header number
lngTop10Seqn = GetNextSeqn
' Show E-Mail flag
varShowEmail = CBool(Request.Form("ShowEMail"))
If Err.number <> 0 Then
varShowEMail = FALSE
Err.Clear
End If
' ---------------------------------------------------------------------
' Delete records that already exist for respondent
' ---------------------------------------------------------------------
' Start transaction
gobjDataConn.BeginTrans
' Define query
strSQL = "" _
& "DELETE tblTop10Hdr.* " _
& "FROM tblTop10Hdr " _
& "WHERE TTH_NAME = '" & Replace(Request.Form.Item("Name"),"'", "''") & "'" _
& " AND TTH_DATE_POSTED = #" & DatePart("m", Date) _
& "/" & DatePart("d", Date) & "/" & DatePart("yyyy", Date) & "#"
' Execute query
gobjDataConn.Execute strSQL
' ---------------------------------------------------------------------
' Create Header record
' ---------------------------------------------------------------------
' Set query parameters
With cmdInsTop10Hdr
.Parameters("TTH_SEQN").value = lngTop10Seqn
.Parameters("TTH_DATE_POSTED").value = Date()
.Parameters("TTH_NAME").value = Request.Form.Item("Name")
.Parameters("TTH_LOCATION").value = Request.Form.Item("Location")
.Parameters("TTH_EMAIL").Value = Request.Form.Item("Email")
.Parameters("TTH_SHOW_EMAIL").Value = varShowEMail
End With
' Attempt to add record. Check whether successful
cmdInsTop10Hdr.Execute lngRecordsAffected
If lngRecordsAffected <> 1 Then
blnErrorsOccurred = TRUE
End If
' ---------------------------------------------------------------------
' Create Item records
' ---------------------------------------------------------------------
If NOT blnErrorsOccurred Then
For intKey = 0 to 9
With cmdInsTop10Itm
.Parameters("TTI_HDR_SEQN").value = lngTop10Seqn
.Parameters("TTI_POSITION").value = intKey + 1
.Parameters("TTI_ARTIST").value = avarTopTen(intKey, 0)
.Parameters("TTI_SONG").value = avarTopTen(intKey, 1)
.Parameters("TTI_COMMENTS").Value = avarTopTen(intKey, 2)
.Parameters("TTI_SONG_KEY").Value = GetSongKey(avarTopTen(intKey, 1))
End With
cmdInsTop10Itm.Execute lngRecordsAffected
If lngRecordsAffected <> 1 Then
blnErrorsOccurred = TRUE
Exit For
End If
Next
End If
' ---------------------------------------------------------------------
' Determine whether to commit transaction
' ---------------------------------------------------------------------
If blnErrorsOccurred Then
gobjDataConn.RollbackTrans
SaveTop10 = FALSE
Else
gobjDataConn.CommitTrans
SaveTop10 = TRUE
End IF
END FUNCTION
FUNCTION GetSongKey(istrSong)
' ---------------------------------------------------------------------
' DESCRIPTION OF ROUTINE
' ---------------------------------------------------------------------
' Purpose: To remove all non-alpha characters from song title,
' so that key can be used for grouping.
' Assumptions: None
' Effects: None
' Inputs: istrSong - song as entered by user
' Returns: Song with all non-alpha characters removed.
' ---------------------------------------------------------------------
' ---------------------------------------------------------------------
' Declare variables
' ---------------------------------------------------------------------
Dim intChar
' position of character in string
Dim strChar
' current character converted to upper case
Dim strSongTitle
' function return value
' ---------------------------------------------------------------------
' Strip out characters
' ---------------------------------------------------------------------
strSongTitle = ""
For intChar = 1 To Len(istrSong)
strChar = UCase(Mid(istrSong, intChar, 1))
If strChar >= "A" And strChar <= "Z" Then
strSongTitle = strSongTitle & strChar
End If
Next
' ---------------------------------------------------------------------
' Return parsed song title
' ---------------------------------------------------------------------
GetSongKey = strSongTitle
END FUNCTION
' *********************************************************************
FUNCTION GetNextSeqn
' ---------------------------------------------------------------------
' DESCRIPTION OF ROUTINE
' ---------------------------------------------------------------------
' Purpose: To get the next sequence number for the Top 10 tables.
' Assumptions: None
' Effects: None
' Inputs: None
' Returns: Next sequence number.
' ---------------------------------------------------------------------
' ---------------------------------------------------------------------
' Declare variables
' ---------------------------------------------------------------------
Dim rstNextSeqn
' recordset containing next sequence number
Dim lngTop10Seqn
' next Top 10 sequence number
' ---------------------------------------------------------------------
' Get maximum Top 10 sequence number
' ---------------------------------------------------------------------
Set rstNextSeqn = Server.CreateObject("ADODB.Recordset")
With rstNextSeqn
Set .ActiveConnection = gobjDataConn
.CursorLocation = adUseClient
.Source = "SELECT MAX(TTH_SEQN) FROM tblTop10Hdr"
.Open
End With
' ---------------------------------------------------------------------
' Add 1 to maximum number
' ---------------------------------------------------------------------
If rstNextSeqn.BOF and rstNextSeqn.EOF Then
lngTop10Seqn = 1
Else
If IsNull(rstNextSeqn.Fields(0)) Then
lngTop10Seqn = 1
Else
lngTop10Seqn = rstNextSeqn.Fields(0) + 1
End If
End If
' ---------------------------------------------------------------------
' Return next sequence number
' ---------------------------------------------------------------------
GetNextSeqn = lngTop10Seqn
END FUNCTION
' *************************************************************************
SUB ShowTop10Hdrs()
' ---------------------------------------------------------------------
' DESCRIPTION OF ROUTINE
' ---------------------------------------------------------------------
' Purpose: To display a list of Top 10 Header records.
' Assumptions: None
' Effects: None
' Inputs: None
' Returns: None
' ---------------------------------------------------------------------
' ---------------------------------------------------------------------
' Declare variables
' ---------------------------------------------------------------------
Dim rstTop10Hdrs
' recordset containing Top 10 Headers
Dim strSQL
' query definition
Dim strCellValue
' cell value
Dim objField
' reference to ADO Field object
Dim intCol
' used to iterate fields in recordset
Dim strEMail
' EMail address
Dim strTop10Url
' URL to display a specific Top 10
Dim intLineNo
' line number. If sequence number is displayed, would be out of
' order if historical Top 10s are entered into database, and
' table is ordered by date posted
Dim lngLineEnd
' last record number in record page
Dim lngSelectedPage
' page number
Dim intPage
' used to iterate page numbers when creating page links
' ---------------------------------------------------------------------
' Define query
' ---------------------------------------------------------------------
strSQL = "" _
& "SELECT * " _
& "FROM tblTop10Hdr " _
& "ORDER BY TTH_DATE_POSTED DESC "
' ---------------------------------------------------------------------
' Get data
' ---------------------------------------------------------------------
Set rstTop10Hdrs = Server.CreateObject("ADODB.Recordset")
With rstTop10Hdrs
Set .ActiveConnection = gobjDataConn
.Source = strSQL
.PageSize = 50
.CursorLocation = adUseClient
.Open
End With
' ---------------------------------------------------------------------
' Get page information
' ---------------------------------------------------------------------
' Evaluate Page number
If Request.QueryString("Page") = "" Then
lngSelectedPage = 1
Else
lngSelectedPage = CLng(Request.QueryString("Page"))
End If
' Set start and end record, and recordset page to display
rstTop10Hdrs.AbsolutePage = lngSelectedPage
rstTop10Hdrs.AbsolutePosition = ((rstTop10Hdrs.AbsolutePage - 1) _
* rstTop10Hdrs.PageSize) + 1
lngEndLine = rstTop10Hdrs.AbsolutePage * rstTop10Hdrs.PageSize
' ---------------------------------------------------------------------
' Create table framework
' ---------------------------------------------------------------------
%>
| No. |
Posted |
Name |
Location |
E-Mail |
<%
' ---------------------------------------------------------------------
' Create table lines
' ---------------------------------------------------------------------
If NOT rstTop10Hdrs.BOF and NOT rstTop10Hdrs.EOF Then
Do Until rstTop10Hdrs.AbsolutePosition > lngEndLine
Response.Write ""
intLineNo = rstTop10Hdrs.AbsolutePosition
' Evaluate E-Mail
strEMail = ""
If CBool(rstTop10Hdrs("TTH_SHOW_EMAIL")) Then
If rstTop10Hdrs("TTH_EMAIL") = "" Then
strEMail = " "
Else
strEMail = "" _
& Server.HTMLEncode(rstTop10Hdrs("TTH_EMAIL")) & ""
End If
Else
strEMail = " "
End If
' Evaluate URL
strTop10Url = "Top10Chart.asp?ID=" & rstTop10Hdrs("TTH_SEQN") _
& "&CAPTION=" & Server.URLEncode(rstTop10Hdrs("TTH_NAME") & " | " & rstTop10Hdrs("TTH_LOCATION"))
' Create line number cell
%>
|
'; return true" onMouseOut="window.status='';return true">
<%=intLineNo%>
|
<%
' Output fields in record
For intCol = 1 to rstTop10Hdrs.Fields.Count - 2
' Evaluate data value
Set objField = rstTop10Hdrs.Fields(intCol)
Select Case UCase(objField.Name)
Case "TTH_SEQN"
strCellValue = "" & objField.value & ""
Case "TTH_EMAIL"
strCellValue = strEMail
Case Else
If IsNull(objField.value) Then
strCellValue = " "
Else
strCellValue = Server.HTMLEncode(objField.value)
End If
End Select
' Output cell
%>
<%=strCellValue%>
|
<%
Next
Response.Write " "
rstTop10Hdrs.MoveNext
if rstTop10Hdrs.EOF then
Exit Do
end if
Loop
Response.Write " "
End If
' ---------------------------------------------------------------------
' Create links to other Top 10 Header pages
' ---------------------------------------------------------------------
Response.Write "
"
' Display a Previous link if not on first page of recordset
If lngSelectedPage > 1 Then
CreatePageLink (lngSelectedPage - 1), "<< Previous ", FALSE
End If
' Display links to all pages, highlighting selected page link
For intPage = 1 to rstTop10Hdrs.PageCount
If intPage = lngSelectedPage Then
CreatePageLink intPage, (" " & intPage & " "), TRUE
Else
CreatePageLink intPage, " " & intPage & " ", FALSE
End If
Next
' Display a Next link if not on the last page of recordset
If lngSelectedPage < rstTop10Hdrs.PageCount Then
CreatePageLink (lngSelectedPage + 1), " Next >>", FALSE
End If
Response.Write "
"
END SUB
' *************************************************************************
SUB DisplayMessage(istrMsg, ivarWidth)
' ---------------------------------------------------------------------
' DESCRIPTION OF ROUTINE
' ---------------------------------------------------------------------
' Purpose: To display a message in the HTML output.
' Assumptions: None
' Effects: None
' Inputs: None
' Returns: None
' ---------------------------------------------------------------------
%>
 |
<%=istrMsg%>
|
<%
END SUB
' *************************************************************************
SUB CreatePageLink(iintPage, istrText, iblnHighlightLink)
' ---------------------------------------------------------------------
' DESCRIPTION OF ROUTINE
' ---------------------------------------------------------------------
' Purpose: To create a link to a page of Top 10 Header records.
' Assumptions: None
' Effects: None
' Inputs: iintPage - page number
' istrText - text for link
' iblnHighlight - whether to highlight link
' Returns: None
' ---------------------------------------------------------------------
' ---------------------------------------------------------------------
' Declare variables
' ---------------------------------------------------------------------
Dim strHTML
' HTML definition of link
' ---------------------------------------------------------------------
' Define link
' ---------------------------------------------------------------------
strHTML = ""
' Highlight link where specified
If iblnHighlightLink Then
strHTML = strHTML & "" & istrText & ""
Else
strHTML = strHTML & "" _
& istrText & ""
End If
' ---------------------------------------------------------------------
' Create link
' ---------------------------------------------------------------------
Response.Write strHTML
END SUB
%>
|
All
ASP script ©2001 JWS
|
|
|
 |
|
|
Disclaimer:
While every attempt has been made to ensure the accuracy of information provided,
the authors of this site take no responsibility for the consequences of use of
this information
This website is offered for noncommercial, educational and entertainment purposes
only |
|
