linkRanking

<%   private sub class_initialize()   %>
Option Explicit
With Response
	.Buffer=True
	.Expires = 0
	.Clear
End With

'
'display a ranked list of web sites from a database and provide
'a method to keep track of how many times each link has been clicked.
'
'
'Version History:
'	3.0 - 6/9/2002
'		- changed url passed from address to id
'		- rebuilt as a vbscript class
'		- repaired the overflow error caused by incorrect
'		  coding in previous versions
'		- opens the db only one time on each run, rather
'		  than 2 times like in previous versions. result
'		  was a speed increase.
'		- returned html is now pretty, rather than one
'		  big string
'
'	2.0 - 8/19/2000
'		- modified to not use global.asa file for persistent 
'		  db connections
'
'	1.0 - 1/9/2000
'		- initial release
'
'
'Properties:
'	ConnString
'		Required. String. Gets/Sets the connection string 
'		to the database used
'	
'		set:
'			obj.ConnString = string
'		get:
'			string = obj.ConnString
'
'		You must set the ConnString property before using
'		any of the methods of the class.
'
'	ConnUser
'		Optional. String. Gets/Sets the user id to use to
'		access the specified database in the ConnString
'		property (SQL Server only)
'	
'		set:
'			obj.ConnUser = string
'		get:
'			string = obj.ConnUser
'
'	ConnPass
'		Optional. String. Gets/Sets the password to use to
'		access the specified user id in the ConnUser
'		property (SQL Server only)
'	
'		set:
'			obj.ConnPass = string
'		get:
'			string = obj.ConnPass
'
'
'Methods:
'	OpenDB
'		Required. Void. Opens the database specified in
'		the ConnString property. This method must be called
'		before any other methods of the class are called.
'
'		obj.OpenDB
'
'	CloseDB
'		Required. Void. Closes the database opened by calling
'		the OpenDB method. You must call this method to close
'		the database. This method is also called automatically
'		when the class terminates, in case you forget to call it.
'
'		obj.CloseDB
'
'	GetLinks
'		Optional. String. Returns a html formatted list of
'		links as a string.
'
'		string = obj.GetLinks
'
'	GetUrl(ByVal id)
'		Optional. String. Increments the count of clicks by one
'		for the specified link and returns the url of the site
'		requested.
'
'		string = obj.GetUrl(id)
'
'
'

Class LinkRanking
	Public ConnString, ConnUser, ConnPass
	Private c

	Private Sub Class_Initialize()
		ConnString = Application("dbConn")
		ConnUser = Application("dbUsr")
		ConnPass = Application("dbPass")
	End Sub

	Private Sub Class_Terminate()
		CloseDB
	End Sub

	Public Sub OpenDB()
		set c = server.createobject("adodb.connection")
		c.Open connstring, connuser, connpass
	End Sub

	Public Sub CloseDB()
		On Error Resume Next
		if isobject(c) then
			c.close
			set c = nothing
		end if
	End Sub

	Public Function GetLinks()
		Dim sBuffer, r, hTotal, hClicks, sTitle, hID
		Dim sAddress

		sBuffer = ""

		if not isobject(c) then
			GetLinks = ""
			exit function
		end if

		'get total amount of clicks for all links
		set r = server.createobject("adodb.recordset")
		r.Open "SELECT Sum(clicks) AS totalClicks FROM linkRanking;", c
		hTotal = CLng(r.fields(0).value)
		r.close
		set r = nothing

		'retrieve the links into buffer
		set r = server.createobject("adodb.recordset")
		r.open "SELECT address, clicks, title, id FROM linkRanking ORDER BY clicks DESC;", c
		if r.bof then
			sBuffer = sBuffer & "there are no links in the database."
		else
			sBuffer = sBuffer & "<table align=center width=450 cellpadding=1 cellspacing=1 border=0 bgcolor=""#60786B"">" & vbcrlf
			sBuffer = sBuffer & vbtab & "<tr>" & vbcrlf
			sBuffer = sBuffer & vbtab & vbtab & "<th><font color=#FFFFFF>link</font></th>" & vbcrlf
    			sBuffer = sBuffer & vbtab & vbtab & "<th><font color=#FFFFFF>popularity</font></th>" & vbcrlf
			sBuffer = sBuffer & vbtab & "</tr>" & vbcrlf
			Do While NOT r.BOF AND NOT r.EOF

				sAddress = r.fields(0).value
				hClicks = CLng(r.fields(1).value)
				sTitle = r.fields(2).value
				hID = r.fields(3).value

		    		sBuffer = sBuffer & vbtab & "<tr>" & vbcrlf
				sBuffer = sBuffer & vbtab & vbtab & "<td bgcolor=""#FFFFEE""><font size=""-1"" face=arial>"
				sBuffer = sBuffer & "<a href=""./linkRanking.asp?id=" & server.urlencode(hID) & """>"
				sBuffer = sBuffer & sTitle & "</a></font></td>" & vbcrlf
				sBuffer = sBuffer & vbtab & vbtab & "<td bgcolor=""#EEEEEE"" align=center>"
				sBuffer = sBuffer & "<font size=""-1"" face=arial>( "
				if hClicks = 0 or hTotal = 0 then
					sBuffer = sBuffer & FormatPercent(0, 1)
				else
					sBuffer = sBuffer & FormatPercent(hClicks / hTotal, 1)
				end if
				sBuffer = sBuffer & " )</font></td>" & vbcrlf
				sBuffer = sBuffer & vbtab & "</tr>" & vbCrLf

				r.Movenext
			LOOP
			sBuffer = sBuffer & "</table>" & vbcrlf
		end if
		r.close
		set r = nothing

		GetLinks = sBuffer
	End Function

	Public Function GetUrl(byval id)
		Dim r, hClicks, sUrl

		if not isobject(c) then
			GetUrl = ""
			exit function
		end if

		set r = server.createobject("adodb.recordset")
		r.Open "SELECT clicks, address FROM linkRanking WHERE id = " & id, c
		if not r.bof then
			hClicks=r.fields(0).value
			sUrl=r.fields(1).value
		else
			hClicks = 0
			sUrl = ""
		end if
		r.close
		set r = nothing

		if not isnumeric(hClicks) then hClicks = 0

		 ' update the clicks for this address
		c.Execute "UPDATE linkRanking SET clicks = " & hClicks + 1 & " WHERE id = " & id

		GetUrl = sUrl
	End Function
End Class
%>


<!--#include file="../inc/function_thisFileName.asp"-->


<html>
 <head>
  <title>The ASP Emporium - Link Ranking Example</title>
  <style type="text/css">
   h3 {color: #CC3300;}
  </style>
 </head>
 <body background="/aspEmporium/pix/bg.gif" bgcolor="#EEEEEE">
 <!--#include virtual="/aspEmporium/inc/top.asp"-->
  <table width=100% cellpadding=2 cellspacing=0 border=0>
   <tr>
    <td valign=top><!--#include virtual="/aspEmporium/inc/sideMenu.asp"--></td>
    <td valign=top>
    <font face="arial, verdana, helvetiva, times new roman">
    <h3>Simple Link Ranking System</h3>
    This quick block of code takes any number of links from an access 
    database and displays them as a table. Each time a link is clicked, 
    the click is recorded in the database and the client is redirected
    to the proper site, creating a simple click thru monitor that records
    the popularity of links.
    <br>
    <br>
Version 3.0 released on June 9, 2002 has the following changes that previous
versions of the software didn't have:
<UL>
<LI>changed querystring passed from address to id (string to int)
<LI>rebuilt as a vbscript class
<LI>repaired the overflow error caused by incorrect coding in previous versions
<LI>opens the db only one time on each run, rather than 2 times like in previous versions. result was a speed increase.
<LI>returned html is now pretty, rather than one big string
</UL>



<%
dim oLinkRank, id, sUri

id = Request("id")
Set oLinkRank = New  LinkRanking
oLinkRank.ConnString = Application("dbConn")
oLinkRank.ConnUser = Application("dbUsr")
oLinkRank.ConnPass = Application("dbPass")
oLinkRank.OpenDB
If Len(trim(id)) = 0 then
	 ' if there is no queryString, we should display our links.
	Response.Write oLinkRank.GetLinks
Else
	' redirect
	suri = oLinkRank.GetUrl(id)
	if len(trim(suri)) = 0 then
		Response.Write oLinkRank.GetLinks
	else
		Response.Redirect suri
	end if
End If
oLinkRank.CloseDB
Set oLinkRank = Nothing
%>





    <br>
    <br>
    <!--#include file="../inc/exampleOptions.asp"-->
    </font>
    </td>
   </tr>
  </table>
 </body>
</html>