%@ Language=VBScript %> <% Response.Buffer = TRUE %> <% ' Script Name : aspWebLinks ' File Name : links.asp ' Version : 2.0 ' Release Date : 10/13/2001 ' License Info : license.txt ' ' Copyright (c) 2001 by fullrevolution.com, all rights reserved ' %> <% '********* Open the database and pull in the config ************************* Dim dbc Dim strConn strConn = "Driver={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath("links/links2.mdb") Set dbc = Server.CreateObject("ADODB.Connection") dbc.open strConn SQL = "SELECT * FROM Config" Set RS=dbc.execute(SQL) SortBy = RS("SortBy") AdministrativePassword = RS("AdministrativePassword") SkinName = RS("SkinName") NumberOfDaysNew = RS("NumberOfDaysNew") HotRating = RS("HotRating") RecordsPerPage = RS("RecordsPerPage") CategoryHeader = RS("CategoryHeader") CategoryCols = RS("CategoryCols") SubCategoryHeader = RS("SubCategoryHeader") ShowCatDescription = RS("ShowCatDescription") HowManyNew = RS("HowManyNew") ShowWhatsNew = RS("ShowWhatsNew") HowManyHot = RS("HowManyHot") ShowWhatsHot = RS("ShowWhatsHot") NeedApproval = RS("NeedApproval") WhatsHotHeader = RS("WhatsHotHeader") WhatsNewHeader = RS("WhatsNewHeader") RS.Close Set RS=Nothing SQL = "SELECT * FROM Skins WHERE SkinName='" & SkinName & "'" Set RS=dbc.execute(SQL) LinkTableTag = RS("LinkTableTag") LinkHeaderBackColor = RS("LinkHeaderBackColor") LinkHeaderFontTag = RS("LinkHeaderFontTag") LinkHeaderButtonsFontTag = RS("LinkHeaderButtonsFontTag") DescriptionTableTag = RS("DescriptionTableTag") DescriptionFontTag = RS("DescriptionFontTag") LinkFooterBackColor = RS("LinkFooterBackColor") LinkFooterFontTag = RS("LinkFooterFontTag") NavigationTableTag = RS("NavigationTableTag") NavigationFontTag = RS("NavigationFontTag") CategoryTableTag = RS("CategoryTableTag") CategoryFontTag = RS("CategoryFontTag") CategorySmallFontTag = RS("CategorySmallFontTag") CategoryHeaderBackColor = RS("CategoryHeaderBackColor") CategoryHeaderFontTag = RS("CategoryHeaderFontTag") TopNavigationTableTag = RS("TopNavigationTableTag") TopNavigationFontTag = RS("TopNavigationFontTag") SubCategoryHeaderBackColor = RS("SubCategoryHeaderBackColor") SubCategoryHeaderFontTag = RS("SubCategoryHeaderFontTag") SubCategoryTableTag = RS("SubCategoryTableTag") SubCategoryFontTag = RS("SubCategoryFontTag") MainCatCountFontTag = RS("MainCatCountFontTag") SubCatCountFontTag = RS("SubCatCountFontTag") WhatsNewHeaderBackColor = RS("WhatsNewHeaderBackColor") WhatsNewHeaderFontTag = RS("WhatsNewHeaderFontTag") WhatsNewTableTag = RS("WhatsNewTableTag") WhatsNewFontTag = RS("WhatsNewFontTag") WhatsNewLinkFontTag = RS("WhatsNewLinkFontTag") WhatsHotHeaderBackColor = RS("WhatsHotHeaderBackColor") WhatsHotHeaderFontTag = RS("WhatsHotHeaderFontTag") WhatsHotTableTag = RS("WhatsHotTableTag") WhatsHotFontTag = RS("WhatsHotFontTag") WhatsHotLinkFontTag = RS("WhatsHotLinkFontTag") AdminTableTag = RS("AdminTableTag") AdminHeaderBackColor = RS("AdminHeaderBackColor") AdminHeaderFontTag = RS("AdminHeaderFontTag") AdminFontTag = RS("AdminFontTag") AdminBackColor = RS("AdminBackColor") WhatsNewFullTableTag = RS("WhatsNewFullTableTag") WhatsHotFullTableTag = RS("WhatsHotFullTableTag") PageHeader = RS("PageHeader") PageFooter = RS("PageFooter") RS.Close Set RS=Nothing %> <% response.write PageHeader '**************************************************************************** '* Subroutines '* '* These routines are used by other parts of the script. '**************************************************************************** '************************************************************************** '******** Count Links '************************************************************************** Function CountLinks (Category) SQLd = "Select Count(*) From Links Where CategoryID = " & Category & " AND Live=1" Set RSd=dbc.execute(SQLd) RSd.MoveFirst NumberLinks = RSd(0) SQLe = "Select * From Categories Where ParentCategoryID = " & Category Set RSe=dbc.execute(SQLe) If Not RSe.EOF then RSe.MoveFirst Do While Not RSe.EOF NumberLinks = NumberLinks + CountLinks(RSe("CategoryID")) RSe.MoveNext Loop End If CountLinks = NumberLinks RSe.Close Set RSe=Nothing End Function '************************************************************************** '******** Login '************************************************************************** Sub Login Call DrawTopNavigation response.write "
aspWebLinks - Administrative Login | " response.write "
" response.write " |
" & CategoryHeader & " | " response.write "" response.write " |
" & RS("CategoryTitle") & ""
NumLinks = CountLinks(RS("CategoryID"))
response.write " (" & NumLinks & ")"
If Session("LoggedIn") = "YES" then
response.write " Delete - "
response.write " Edit"
End If
response.write " " If ShowCatDescription = "NO" then SQLc = "Select * From Categories Where ParentCategoryID = " & CurrentCategory & " Order By CategoryTitle;" Set RSc=Server.CreateObject("adodb.Recordset") RSc.Open SQLc, dbc, adopenstatic If RSc.RecordCount > 0 then If RSc.RecordCount < 3 then L = RSc.RecordCount Else L = 3 End If RSc.MoveFirst For J = 1 to L response.write "" & RSc("CategoryTitle") & ", " RSc.MoveNext Next response.write "..." End If RSc.Close Set RSc=Nothing Else response.write "" & RS("Description") End If response.write " | "
RS.MoveNext
Next
response.write "
" & SubCategoryHeader & " | " response.write "" response.write " |
" & RS("CategoryTitle") & ""
NumLinks = CountLinks(RS("CategoryID"))
response.write " (" & NumLinks & ")"
If Session("LoggedIn") = "YES" then
response.write " Delete - "
response.write " Edit"
End If
response.write " " response.write " | "
RS.MoveNext
Next
response.write "
" response.write "" response.write "Top \ " response.write TempNavCategory response.write " | " response.write "" response.write "" response.write "" If Session("LoggedIn") <> "YES" then If AddCategory <> 0 then response.write "Add A Link | Whats New | Whats Hot | Search | Admin" Else response.write "Whats New | Whats Hot | Search | Admin" End If Else response.write "ADMIN MODE: " If AddCategory <> 0 then response.write "Add A Link | Add A Category | Approve Links | Review Errors | Approve Reviews | Modify Config | Modify Style | Log Off" Else response.write "Add A Category | Approve Links | Review Errors | Approve Reviews | Modify Config | Modify Style | Log Off" End If End If response.write " | " response.write "
aspWebLinks - Add A Link | " response.write "
" response.write " |
aspWebLinks - Add A Link | " response.write "||||||||||||||
The following was submitted to the administrator for approval... | ||||||||||||||
The following was submitted added to the links database... | ||||||||||||||
"
response.write "
|
aspWebLinks - Add A Category | " response.write "
" response.write " |
aspWebLinks - Add A Category | " response.write "||||||||
The following category was added to the links database... | ||||||||
"
response.write "
|
aspWebLinks - Edit Category | " response.write "
" response.write " |
aspWebLinks - Edit Link | " response.write "
" response.write " |
aspWebLinks - Approve Links | " response.write "
" response.write " |
" & WhatsNewHeader & " | " response.write "" response.write " | ||
" & TempNumber & "." response.write " | " & RSf("LinkTitle") & "" response.write " | Date Added: " & RSf("LinkDateAdded")
response.write " " response.write " | "
TempNumber = TempNumber + 1
End If
RSf.MoveNext
if RSf.EOF then exit for
Next
If AreNew = 0 then
response.write "|
There are currently no NEW listings!" response.write " | " End If response.write "
" & WhatsNewHeader & " | " response.write "" response.write " | ||
" & TempNumber & "." response.write " | " & RSf("LinkTitle") & " - " & RSf("LinkDescription") & "" response.write " | Date Added: " & RSf("LinkDateAdded")
response.write " " response.write " | "
TempNumber = TempNumber + 1
End If
RSf.MoveNext
if RSf.EOF then Exit For
Next
If AreNew = 0 then
response.write "|
There are currently no NEW listings!" response.write " | " End If response.write "
" & WhatsHotHeader & " | " response.write "" response.write " | ||
" & TempNumber & "." response.write " | " & RSg("LinkTitle") & "" response.write " | Visits: " & RSg("LinkVisits")
response.write " " response.write " | "
TempNumber = TempNumber + 1
End If
RSg.MoveNext
if RSg.EOF then exit for
Next
If AreHot = 0 then
response.write "|
There are currently no HOT listings!" response.write " | " End If response.write "
" & WhatsHotHeader & " | " response.write "" response.write " | ||
" & TempNumber & "." response.write " | " & RSg("LinkTitle") & " - " & RSg("LinkDescription") & "" response.write " | Visits: " & RSg("LinkVisits")
response.write " " response.write " | "
TempNumber = TempNumber + 1
End If
RSg.MoveNext
if rsg.eof then exit for
Next
If AreHot = 0 then
response.write "|
There are currently no HOT listings!" response.write " | " End If response.write "
" & RS("LinkTitle") & "" DaysNew = DateDiff("d", RS("LinkDateAdded"), Now) Hot = RS("LinkVisits") if DaysNew <= NumberOfDaysNew Then response.write "" end if if Hot > HotRating Then response.write "" end if If Session("LoggedIn") = "YES" then response.write " Delete - " response.write " Edit" End If response.write " | " response.write ""
SQLx = "Select AVG(Rating) From Ratings Where LinkID=" & RS("LinkID") & ";"
set RSx=Server.CreateObject("adodb.Recordset")
RSx.Open SQLx, dbc, adopenstatic
SQLr = "Select * From Reviews Where LinkID=" & RS("LinkID") & ";"
set RSr=Server.CreateObject("adodb.Recordset")
RSr.Open SQLr, dbc, adopenstatic
If NOT RSr.EOF then
If NeedApproval = "YES" then
RSr.Filter = "ReviewLive = '1'"
End If
End If
If RSx.EOF then
RatingAverage = "Not Rated"
Else
RatingAverage = RSx(0)
End If
RSx.Close
Set RSx=nothing
response.write " Error | " response.write "Review | " response.write "Rate | Avg Rating: " If RatingAverage <> "Not Rated" then For Z = 1 to RatingAverage response.write "" Next Else response.write "Not Rated" End If RatingAverage = 0 response.write " | "
response.write "||||
"
response.write "
|
aspWebLinks - Search | " response.write "
" response.write " |
" & RS("LinkTitle") & "" DaysNew = DateDiff("d", RS("LinkDateAdded"), Now) Hot = RS("LinkVisits") if DaysNew <= NumberOfDaysNew Then response.write "" end if if Hot > HotRating Then response.write "" end if If Session("LoggedIn") = "YES" then response.write " Delete - " response.write " Edit" End If response.write " | " response.write ""
SQLx = "Select AVG(Rating) From Ratings Where LinkID=" & RS("LinkID") & ";"
set RSx=Server.CreateObject("adodb.Recordset")
RSx.Open SQLx, dbc, adopenstatic
If RSx.EOF then
RatingAverage = "Not Rated"
Else
RatingAverage = RSx(0)
End If
RSx.Close
Set RSx=nothing
response.write " Rate This Link | Avg Rating: " If RatingAverage <> "Not Rated" then For Z = 1 to RatingAverage response.write "" Next Else response.write "Not Rated" End If RatingAverage = 0 response.write " | "
response.write "||||
"
response.write "
|
aspWebLinks - Rate A Link | " response.write "
" response.write " |
" response.write "" response.write "Displaying Links: " & FirstLink & "-" & LastLink & " of " & TotalLinks response.write " | " response.write "" response.write "" if Page <> 1 then response.write "" response.write "<< Prev" end if if Page <> 1 then response.write " " end if For intCount = 1 to RS.PageCount If intCount = 1 then response.write " | " End If If cint(intCount) = cint(Page) then response.write "" & intCount & " | " Else response.write "" & intCount & " | " End If Next if cint(page) <> cint(RS.PageCount) then response.write "" response.write " Next >>" end if if cint(Page) = cint(RS.PageCount) then response.write "" end if response.write " | " response.write "
aspWebLinks | " response.write "||||||||||||||||
"
response.write "
|
aspWebLinks - Review A Link | " response.write "
" response.write " |
" & RSr("ReviewTitle") & " "
For I = 1 to RSr("ReviewRating")
response.write ""
Next
response.write "   Review By: " & RSr("ReviewerName") & " | " & RSr("ReviewDate") response.write " | "
response.write "|
"
response.write "
|
aspWebLinks - Report An Error | " response.write "
" response.write " |
aspWebLinks - Approve Reviews | " response.write "
" response.write " |
aspWebLinks - Review Errors | " response.write "
" response.write " |
aspWebLinks - Modify Configuration | " response.write "
" response.write " |
aspWebLinks - Modify Style | " response.write "
" response.write " |