<%@ 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 "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
aspWebLinks - Administrative Login
" response.write "
" response.write "
Enter Administrative Password:
" response.write "
" response.write "" If request.querystring("err") = "wrongpass" then response.write "Sorry you entered an invalid password, please try again...
" End If End Sub '-------------------------------------------------------------------------- '-------- Process Login '-------------------------------------------------------------------------- Sub ProcessLogin If request.form("txtPassword") = AdministrativePassword then Session("LoggedIn") = "YES" response.redirect "links.asp" Else Session("LoggedIn") = "NO" response.redirect "links.asp?action=admin&err=wrongpass" End If End Sub '************************************************************************** '******** Log Off '************************************************************************** Sub LogOff Session("LoggedIn") = "NO" response.redirect "links.asp" End Sub '************************************************************************** '******** DrawTopCategories '************************************************************************** Sub DrawTopCategories SQL = "Select * From Categories Where ParentCategoryID = 0 Order By CategoryTitle;" Set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic response.write "" response.write "" response.write "" response.write "" response.write "" Span=0 RS.MoveFirst For I = 1 to RS.RecordCount Span=span + 1 if Span > CategoryCols then response.write "" Span = 1 end if CurrentCategory = RS("CategoryID") response.write "" RS.MoveNext Next response.write "
" & CategoryHeader & "
" & 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.Close Set RS=Nothing End Sub '************************************************************************** '******** DrawSubCategories '************************************************************************** Sub DrawSubCategories SQL = "Select * From Categories Where ParentCategoryID = " & Category & " Order By CategoryTitle;" Set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic If RS.RecordCount > 0 then response.write "" response.write "" response.write "" response.write "" response.write "" Span=0 RS.MoveFirst For I = 1 to RS.RecordCount Span=span + 1 if Span > CategoryCols then response.write "" Span = 1 end if response.write "" RS.MoveNext Next response.write "
" & SubCategoryHeader & "
" & 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 "
" response.write "
" End if RS.Close Set RS=Nothing End Sub '************************************************************************** '******** DrawTopNavigation '************************************************************************** Sub DrawTopNavigation SQL = "Select * From Categories Where CategoryID = " & Category Set RSp=Server.CreateObject("adodb.Recordset") RSp.Open SQL, dbc, adopenstatic If RSp.RecordCount > 0 then RSp.MoveFirst End If If Category <> 0 then TempCategory = RSp("CategoryID") TempNavCategory = " " & RSp("CategoryTitle") & "" TempCategoryID = RSp("ParentCategoryID") ParentCat = request.querystring("cat") AddCategory = TempCategory Else TempCategory = 0 TempNavCategory = "" TempCategoryID = 0 AddCategory = 0 ParentCat = 0 End If If TempCategoryID <> 0 then Do While Not TempCategoryID = 0 SQLi = "Select * From Categories Where CategoryID = " & TempCategoryID Set RSi=Server.CreateObject("adodb.Recordset") RSi.Open SQLi, dbc, adopenstatic RSi.MoveFirst TempCategory = RSi("CategoryID") TempNavCategory = " " & RSi("CategoryTitle") + " \" + TempNavCategory TempCategoryID = RSi("ParentCategoryID") Loop RSi.Close Set RSi=Nothing End If response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" response.write "Top \ " response.write TempNavCategory 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 "
" RSp.Close Set RSp=Nothing End Sub '************************************************************************** '******** Add A Link '************************************************************************** Sub AddLink SQLh = "Select * From Categories Where CategoryID = " & request.querystring("cat") Set RSh=Server.CreateObject("adodb.Recordset") RSh.Open SQLh, dbc, adopenstatic If RSh.RecordCount <> 0 then RSh.MoveFirst AddCategoryID = request.querystring("cat") AddToCategory = RSh("CategoryTitle") TempCategoryID = RSh("ParentCategoryID") Else AddCategoryID = 0 AddToCategory = "Top" TempCategoryID = 0 End If If TempCategoryID <> 0 then Do While Not TempCategoryID = 0 SQLi = "Select * From Categories Where CategoryID = " & TempCategoryID Set RSi=Server.CreateObject("adodb.Recordset") RSi.Open SQLi, dbc, adopenstatic RSi.MoveFirst AddToCategory = RSi("CategoryTitle") + "\" + AddToCategory TempCategoryID = RSi("ParentCategoryID") Loop RSi.Close Set RSi=Nothing End If Call DrawTopNavigation response.write "aspWebLinks - Add A Link" response.write "
" response.write "" response.write "" response.write "
aspWebLinks - Add A Link
" response.write "
" response.write "" response.write "" response.write "" If NeedApproval = "YES" then response.write "" Else response.write "" End If response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Link Title:
Link URL:
Link Description:
Link Category:" & AddToCategory & "
Date Added:" & Date() & "
Email Address:
" RSh.Close Set RSh=Nothing End Sub '-------------------------------------------------------------------------- '-------- Add The Link '-------------------------------------------------------------------------- Sub AddTheLink txtLinkTitle = Replace(Request.Form("txtLinkTitle"),chr(34),"'") txtLinkURL = Replace(Request.Form("txtLinkURL"),chr(34),"'") txtLinkDescription = Replace(Request.Form("txtLinkDescription"),chr(34),"'") txtLinkCategoryID = Replace(Request.Form("txtLinkCategoryID"),chr(34),"'") txtLinkDateAdded = Replace(Request.Form("txtLinkDateAdded"),chr(34),"'") txtEmail = Replace(Request.Form("txtEmail"),chr(34),"'") txtLive = Replace(Request.Form("txtLive"),chr(34),"'") Set RSj=Server.CreateObject("ADODB.RecordSet") RSj.Open "Select * From Links", dbc, adOpenDynamic, adLockPessimistic, adCMDText RSj.AddNew RSj("LinkTitle")=txtLinkTitle RSj("LinkURL")=txtLinkURL RSj("LinkDescription")=txtLinkDescription RSj("CategoryID")=txtLinkCategoryID RSj("LinkDateAdded")=txtLinkDateAdded RSj("Email")=txtEmail RSj("Live")=txtLive RSj.Update RSj.Close Set RSj=Nothing response.write "aspWebLinks - Add A Link" response.write "
" response.write "" response.write "" response.write "" If NeedApproval = "YES" then response.write "" Else response.write "" End If response.write "
aspWebLinks - Add A Link
The following was submitted to the administrator for approval...
The following was submitted added to the links database...
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Link Title:" & request.form("txtLinkTitle") & "
Link URL:" & request.form("txtLinkURL") & "
Link Description:" & request.form("txtLinkDescription") & "
Link Category:" & request.form("txtLinkCategoryID") & "
Date Added:" & request.form("txtLinkDateAdded") & "
Email Address:" & request.form("txtEmail") & "
Click Here to return...
" End Sub '************************************************************************** '******** Add A Category '************************************************************************** Sub AddACategory SQLh = "Select * From Categories Where CategoryID = " & request.querystring("parentcat") Set RSh=Server.CreateObject("adodb.Recordset") RSh.Open SQLh, dbc, adopenstatic If RSh.RecordCount <> 0 then RSh.MoveFirst AddCategoryID = request.querystring("parentcat") AddToCategory = RSh("CategoryTitle") TempCategoryID = RSh("ParentCategoryID") Else AddCategoryID = 0 AddToCategory = "Top" TempCategoryID = 0 End If If TempCategoryID <> 0 then Do While Not TempCategoryID = 0 SQLi = "Select * From Categories Where CategoryID = " & TempCategoryID Set RSi=Server.CreateObject("adodb.Recordset") RSi.Open SQLi, dbc, adopenstatic RSi.MoveFirst AddToCategory = RSi("CategoryTitle") + "\" + AddToCategory TempCategoryID = RSi("ParentCategoryID") Loop RSi.Close Set RSi=Nothing End If Call DrawTopNavigation response.write "aspWebLinks - Add A Category" response.write "
" response.write "" response.write "" response.write "
aspWebLinks - Add A Category
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Category Title:
Category Description:
Link Category:" & AddToCategory & "
" RSh.Close Set RSh=Nothing End Sub '-------------------------------------------------------------------------- '-------- Add The Category '-------------------------------------------------------------------------- Sub AddTheCategory txtCategoryTitle = Replace(Request.Form("txtCategoryTitle"),chr(34),"'") txtCategoryDescription = Replace(Request.Form("txtCategoryDescription"),chr(34),"'") txtParentCategoryID = Replace(Request.Form("txtParentCategoryID"),chr(34),"'") Set RSj=Server.CreateObject("ADODB.RecordSet") RSj.Open "Select * From Categories", dbc, adOpenDynamic, adLockPessimistic, adCMDText RSj.AddNew RSj("CategoryTitle")=txtCategoryTitle RSj("Description")=txtCategoryDescription RSj("ParentCategoryID")=txtParentCategoryID RSj.Update RSj.Close Set RSj=Nothing response.write "aspWebLinks - Add A Category" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "
aspWebLinks - Add A Category
The following category was added to the links database...
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Category Title:" & request.form("txtCategoryTitle") & "
Category Description:" & request.form("txtCategoryDescription") & "
Parent Category:" & request.form("txtParentCategoryID") & "
Click Here to return...
" End Sub '************************************************************************** '******** Edit A Category '************************************************************************** Sub EditCategory SQL = "Select * From Categories Where CategoryID = " & request.querystring("cat") Set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic response.write "aspWebLinks - Edit Category" response.write "
" response.write "" response.write "" response.write "
aspWebLinks - Edit Category
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Category Title:
Category Description:
Parent Category:" & RS("ParentCategoryID") & "
" RS.Close Set RS=Nothing End Sub '-------------------------------------------------------------------------- '-------- Edit Category Process '-------------------------------------------------------------------------- Sub EditCategoryProcess txtCategoryID = Request.Form("txtCategoryID") txtParentCategoryID = Replace(Request.Form("txtParentCategoryID"),chr(34),"'") txtDescription = Replace(Request.Form("txtDescription"),chr(34),"'") txtCategoryTitle = Replace(Request.Form("txtCategoryTitle"),chr(34),"'") txtParentCategoryID = replace(txtParentCategoryID,"'","''") txtDescription = replace(txtDescription,"'","''") txtCategoryTitle= replace(txtCategoryTitle,"'","''") SQL="Update Categories Set CategoryTitle = '"&txtCategoryTitle&"', ParentCategoryID = '"&txtParentCategoryID&"', Description = '"&txtDescription&"' Where [CategoryID] ="&txtCategoryID&"" response.write SQL dbc.Execute(SQL) if request.querystring("rd")="" then response.redirect "links.asp" else response.redirect "links.asp?action=" & request.querystring("rd") end if End Sub '************************************************************************** '******** Edit A Link '************************************************************************** Sub EditLink SQL = "Select * From Links Where LinkID = " & request.querystring("link") Set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic response.write "aspWebLinks - Edit Link" response.write "
" response.write "" response.write "" response.write "
aspWebLinks - Edit Link
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Link Title:
Link URL:
Link Description:
Link Category:" & RS("CategoryID") & "
Date Added:" & RS("LinkDateAdded") & "
Email Address:
" RS.Close Set RS=Nothing End Sub '-------------------------------------------------------------------------- '-------- Edit Link Process '-------------------------------------------------------------------------- Sub EditLinkProcess txtLinkID = Request.Form("txtLinkID") txtLinkTitle = Replace(Request.Form("txtLinkTitle"),chr(34),"'") txtLinkURL = Replace(Request.Form("txtLinkURL"),chr(34),"'") txtLinkDescription = Replace(Request.Form("txtLinkDescription"),chr(34),"'") txtEmail = Replace(Request.Form("txtEmail"),chr(34),"'") txtLinkCategoryID = Request.Form("txtLinkCategoryID") txtLive = Request.Form("txtLive") txtLinkDateAdded = Request.Form("txtLinkDateAdded") txtLinkVisits = Request.Form("txtLinkVisits") txtLinkTitle = replace(txtLinkTitle,"'","''") txtLinkUrl = replace(txtLinkUrl,"'","''") txtLinkDescription = replace(txtLinkDescription,"'","''") txtEmail = replace(txtEmail,"'","''") SQL="Update Links Set LinkTitle = '"&txtLinkTitle&"', LinkVisits = '"&txtLinkVisits&"', LinkURL = '"&txtLinkURL&"', LinkDescription = '"&txtLinkDescription&"', CategoryID = '"&txtLinkCategoryID&"', Live = '"&txtLive&"', Email = '"&txtEmail&"', LinkDateAdded = '"&txtLinkDateAdded&"' Where [LinkID] ="&txtLinkID&"" response.write SQL dbc.Execute(SQL) response.redirect "links.asp?cat=" & txtLinkCategoryID End Sub '************************************************************************** '******** Approve Links '************************************************************************** Sub ApproveLinks SQL = "Select * From Links Where Live = 0 Order By LinkTitle" Set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic If RS.RecordCount <> 0 then RS.MoveFirst End If Call DrawTopNavigation response.write "aspWebLinks - Approve Links" response.write "
" response.write "" response.write "" response.write " <% RS.MoveNext Loop End If %>
aspWebLinks - Approve Links
" response.write "
" If RS.RecordCount = 0 then response.write "There are currently no links pending approval.
" Else Do While Not RS.EOF %>
"><%=RS("LinkTitle")%> - <%=RS("LinkDescription")%> - "><%=RS("LinkURL")%> - Delete
<% RS.Close Set RS=Nothing %>
<% End Sub '-------------------------------------------------------------------------- '-------- Approve Links '-------------------------------------------------------------------------- Sub ApproveProcess SQL = "Update Links Set Live = 1 WHERE LinkID IN("&request.form("toApprove")&")" Set RS = dbc.Execute(SQL) Set RS=Nothing if request.querystring("rd")="" then response.redirect "links.asp" else response.redirect "links.asp?action=" & request.querystring("rd") end if End Sub '************************************************************************** '******** Delete Links '************************************************************************** Sub DeleteLink SQL = "DELETE FROM Links WHERE LinkID IN("& request.querystring("link") &")" Set RS = dbc.Execute(SQL) Set RS=Nothing if request.querystring("also")="clearerr" then Call ReviewErrorsProcess end if if request.querystring("rd")="" then response.redirect "links.asp" else response.redirect "links.asp?action=" & request.querystring("rd") end if End Sub '************************************************************************** '******** Delete Category '************************************************************************** Sub DeleteCategory SQLc = "Select * From Categories WHERE CategoryID = " & request.querystring("cat") Set RSc=Server.CreateObject("adodb.Recordset") RSc.Open SQLc, dbc, adopenstatic NewCategory = RSc("ParentCategoryID") RSc.Close Set RSc = Nothing SQLb = "Select * From Links WHERE CategoryID = " & request.querystring("cat") Set RSb=Server.CreateObject("adodb.Recordset") RSb.Open SQLb, dbc, adopenstatic If RSb.RecordCount <= 0 then SQL = "DELETE FROM Categories WHERE CategoryID IN("& request.querystring("cat") &")" Set RS = dbc.Execute(SQL) response.redirect "links.asp" Else response.write "You cannot delete a category unless it contains NO links
" response.write "Click here" End If RSb.Close Set RSb=Nothing End Sub '************************************************************************** '******** DrawWhatsNew '************************************************************************** Sub WhatsNew SQLf = "Select * From Links Order By LinkDateAdded DESC" Set RSf=Server.CreateObject("adodb.Recordset") RSf.Open SQLf, dbc, adopenstatic If NeedApproval = "YES" then RSf.Filter = "Live = '1'" End If If Not RSf.EOF then RSf.MoveFirst TempNumber = 1 If RSf.RecordCount > 0 then response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" AreNew = 0 For A = 1 to HowManyNew TempDate = DateDiff("d", RSf("LinkDateAdded"), Now) If TempDate <= NumberOfDaysNew then AreNew = 1 response.write "" response.write "" TempNumber = TempNumber + 1 End If RSf.MoveNext if RSf.EOF then exit for Next If AreNew = 0 then response.write "" response.write "" End If response.write "
" & WhatsNewHeader & "
" & TempNumber & "." response.write "" & RSf("LinkTitle") & "" response.write "Date Added: " & RSf("LinkDateAdded") response.write "
" response.write "
There are currently no NEW listings!" response.write "
" End If End If RSf.Close Set RSf=Nothing End Sub '************************************************************************** '******** DrawWhatsNewFull '************************************************************************** Sub WhatsNewFull SQLf = "Select * From Links Order By LinkDateAdded DESC" Set RSf=Server.CreateObject("adodb.Recordset") RSf.Open SQLf, dbc, adopenstatic If NeedApproval = "YES" then RSf.Filter = "Live = '1'" End If If Not RSf.EOF then RSf.MoveFirst TempNumber = 1 Call DrawTopNavigation If RSf.RecordCount > 0 then response.write "" response.write "" response.write "" response.write "" response.write "" AreNew = 0 For A = 1 to RSf.RecordCount TempDate = DateDiff("d", RSf("LinkDateAdded"), Now) If TempDate <= NumberOfDaysNew then AreNew = 1 response.write "" response.write "" TempNumber = TempNumber + 1 End If RSf.MoveNext if RSf.EOF then Exit For Next If AreNew = 0 then response.write "" response.write "" End If response.write "
" & WhatsNewHeader & "
" & TempNumber & "." response.write "" & RSf("LinkTitle") & " - " & RSf("LinkDescription") & "" response.write "Date Added: " & RSf("LinkDateAdded") response.write "
" response.write "
There are currently no NEW listings!" response.write "
" End If End If RSf.Close Set RSf=Nothing End Sub '************************************************************************** '******** DrawWhatsHot '************************************************************************** Sub WhatsHot SQLg = "Select * From Links Order By LinkVisits DESC" Set RSg=Server.CreateObject("adodb.Recordset") RSg.Open SQLg, dbc, adopenstatic If NeedApproval = "YES" then RSg.Filter = "Live = '1'" End If If Not RSg.EOF then RSg.MoveFirst TempNumber = 1 If RSg.RecordCount > 0 then response.write "" response.write "" response.write "" response.write "" response.write "" AreHot = 0 For B = 1 to HowManyHot If RSg("LinkVisits") >= HotRating then AreHot = 1 response.write "" response.write "" TempNumber = TempNumber + 1 End If RSg.MoveNext if RSg.EOF then exit for Next If AreHot = 0 then response.write "" response.write "" End If response.write "
" & WhatsHotHeader & "
" & TempNumber & "." response.write "" & RSg("LinkTitle") & "" response.write "Visits: " & RSg("LinkVisits") response.write "
" response.write "
There are currently no HOT listings!" response.write "
" response.write "
" End If End If RSg.Close Set RSg=Nothing End Sub '************************************************************************** '******** DrawWhatsHotFull '************************************************************************** Sub WhatsHotFull SQLg = "Select * From Links Order By LinkVisits DESC" Set RSg=Server.CreateObject("adodb.Recordset") RSg.Open SQLg, dbc, adopenstatic If NeedApproval = "YES" then RSg.Filter = "Live = '1'" End If If Not RSg.EOF then RSg.MoveFirst TempNumber = 1 Call DrawTopNavigation If RSg.RecordCount > 0 then response.write "" response.write "" response.write "" response.write "" response.write "" AreHot = 0 For B = 1 to RSg.RecordCount If RSg("LinkVisits") >= HotRating then AreHot = 1 response.write "" response.write "" TempNumber = TempNumber + 1 End If RSg.MoveNext if rsg.eof then exit for Next If AreHot = 0 then response.write "" response.write "" End If response.write "
" & WhatsHotHeader & "
" & TempNumber & "." response.write "" & RSg("LinkTitle") & " - " & RSg("LinkDescription") & "" response.write "Visits: " & RSg("LinkVisits") response.write "
" response.write "
There are currently no HOT listings!" response.write "
" response.write "
" End If End If RSg.Close Set RSg=Nothing End Sub '************************************************************************** '******** Goto A Link '************************************************************************** Sub GotoLink Dim SQLb SQL = "Select * From Links Where LinkID =" & request.querystring("gotolink") Set RS = dbc.Execute(SQL) Visits = RS("LinkVisits") + 1 SQLb ="Update Links Set LinkVisits =" & Visits & " Where [LinkID] = " & request.querystring("gotolink") response.write SQLb dbc.Execute(SQLb) Location = RS("LinkURL") RS.Close Set RS=Nothing response.redirect Location End Sub '************************************************************************** '******** Draw the Links '************************************************************************** Sub DrawLinks if SortBy = "ALPHA" then SQL = "Select * From Links Where CategoryID=" & Category & " ORDER BY LinkTitle;" end if if SortBy = "DATE" then SQL = "Select * From Links Where CategoryID=" & Category & " ORDER BY LinkDateAdded DESC, LinkTitle;" end if if SortBy = "HITS" then SQL = "Select * From Links Where CategoryID=" & Category & " ORDER BY LinkVisits DESC, LinkTitle;" end if 'SQL = "Select * From Links Where CategoryID=" & Category & " ORDER BY LinkTitle;" If ReadingReview = "TRUE" then SQL = "Select * From Links Where LinkID=" & request.querystring("link") End If set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic If ReadingReview = "TRUE" then Category = RS("CategoryID") End If If NeedApproval = "YES" then RS.Filter = "Live = '1'" End If If Category <> 0 then If RS.RecordCount = 0 then response.write "" response.write "There are no links in this category!" exit sub End if If request.querystring("Page") = "" Then Page = 1 RS.Move First Else Page = Request.QueryString("Page") If Page = 1 then RS.Move First Else RS.Move CInt((Page * RecordsPerPage) - RecordsPerPage) End If End If FirstLink = ((Page * RecordsPerPage) - RecordsPerPage) + 1 LastLink = ((Page * RecordsPerPage) - RecordsPerPage) + RecordsPerPage TotalLinks = RS.RecordCount If LastLink > TotalLinks then LastLink = TotalLinks End if n = 0 RS.PageSize = RecordsPerPage If ReadingReview <> "TRUE" then Call DrawNavigation response.write "
" End If Do until RS.EOF if n = RecordsPerPage then exit do end if response.write "" response.write "" response.write "" response.write "" 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 "" 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 "" response.write "" response.write "" response.write "" response.write "" response.write "
Description: " response.write RS("LinkDescription") response.write "
" & RS("LinkURL") response.write "" response.write "

" If NOT RSr.EOF then response.write "Read Reviews | " End If response.write "Date Added: " & RS("LinkDateAdded") & " | Visits: " & RS("LinkVisits") & "" response.write "

" response.write "
" RS.MoveNext n=n+1 loop If ReadingReview <> "TRUE" then Call DrawNavigation End If End If RS.Close Set RS=Nothing End Sub '************************************************************************** '******** Search '************************************************************************** Sub Search Call DrawTopNavigation response.write "aspWebLinks - Search" response.write "
" response.write "" response.write "" response.write "
aspWebLinks - Search
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Search For:
Search In:Title Description
" End Sub '-------------------------------------------------------------------------- '-------- SearchExecute '-------------------------------------------------------------------------- Sub SearchExecute SQL = "Select * From Links Where " & request.form("txtSearchIn") & " LIKE '%" & request.form("txtKeywords") & "%' ORDER BY LinkTitle;" set RS=Server.CreateObject("adodb.Recordset") 'response.write SQL RS.Open SQL, dbc, adopenstatic If NeedApproval = "YES" then RS.Filter = "Live = '1'" End If If RS.RecordCount = 0 then response.write "There are no links in this category!" exit sub End if FirstLink = ((Page * RecordsPerPage) - RecordsPerPage) + 1 LastLink = ((Page * RecordsPerPage) - RecordsPerPage) + RecordsPerPage TotalLinks = RS.RecordCount If LastLink > TotalLinks then LastLink = TotalLinks End if n = 0 RS.PageSize = RecordsPerPage Call DrawTopNavigation Do until RS.EOF response.write "" response.write "" response.write "" response.write "" 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 "" 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 "" response.write "" response.write "" response.write "" response.write "" response.write "
Description: " response.write RS("LinkDescription") response.write "
" & RS("LinkURL") response.write "" response.write "

Date Added: " & RS("LinkDateAdded") & " | Visits: " & RS("LinkVisits") & "" response.write "

" response.write "
" RS.MoveNext n=n+1 loop 'Call DrawNavigation RS.Close Set RS=Nothing End Sub '************************************************************************** '******** Rate A Link '************************************************************************** Sub RateLink UserIPAddress = Request.ServerVariables("Remote_Addr") SQL = "Select * From Links Where LinkID = " & request.querystring("LinkID") & ";" set RSz=Server.CreateObject("adodb.Recordset") RSz.Open SQL, dbc, adopenstatic Call DrawTopNavigation response.write "aspWebLinks - Rate A Link" response.write "
" response.write "" response.write "" response.write "
aspWebLinks - Rate A Link
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Link Title:" & RSz("LinkTitle") & "
Rate this link on a scale from 1 to 5 (1 being the lowest, 5 being the highest):12345
Email Address:
" RSz.Close Set RSz=Nothing End Sub '-------------------------------------------------------------------------- '-------- Rate Execute '-------------------------------------------------------------------------- Sub RateExecute txtLinkID = Replace(Request.Form("txtLinkID"),chr(34),"'") txtRating = Replace(Request.Form("txtRating"),chr(34),"'") txtEmailAddress = Replace(Request.Form("txtEmailAddress"),chr(34),"'") txtIPAddress = Request.Form("txtIPAddress") Set RSj=Server.CreateObject("ADODB.RecordSet") SQL = "Select * From Ratings WHERE LinkID=" & txtLinkID RSj.Open SQL, dbc, adOpenDynamic, adLockPessimistic, adCMDText AlreadyVoted = "FALSE" If NOT RSj.EOF then RSj.MoveFirst End If Do While NOT RSj.EOF If RSj("IPAddress") = txtIPAddress then AlreadyVoted = "TRUE" End If RSj.MoveNext Loop If AlreadyVoted = "FALSE" then RSj.AddNew RSj("LinkID")=txtLinkID RSj("Rating")=txtRating RSj("IPAddress")=txtIPAddress RSj("EmailAddress")=txtEmailAddress RSj.Update RSj.Close Set RSj=Nothing response.redirect "links.asp?action=summary&topic=voteOK&LinkID=" & txtLinkID Else response.redirect "links.asp?action=summary&topic=alreadyvoted&LinkID=" & txtLinkID End If End Sub '************************************************************************** '******** Draw the Page Navigation '************************************************************************** Sub DrawNavigation response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
" response.write "" response.write "Displaying Links: " & FirstLink & "-" & LastLink & " of " & TotalLinks 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 "
" End Sub '************************************************************************** '******** Draw the Summary Page '************************************************************************** Sub Summary 'SQL = "Select * From Links Where LinkID = " & request.querystring("LinkID") & ";" 'set RSz=Server.CreateObject("adodb.Recordset") 'RSz.Open SQL, dbc, adopenstatic Call DrawTopNavigation response.write "aspWebLinks" response.write "
" response.write "" response.write "" response.write "
aspWebLinks
" response.write "" response.write "" If request.querystring("topic") = "alreadyvoted" then response.write "" response.write "" End If If request.querystring("topic") = "alreadyreviewed" then response.write "" response.write "" End If If request.querystring("topic") = "voteOK" then response.write "" response.write "" End If If request.querystring("topic") = "errorOK" then response.write "" response.write "" End If If request.querystring("topic") = "configupdatedOK" then response.write "" response.write "" End If If request.querystring("topic") = "deletereviewOK" then response.write "" response.write "" End If If request.querystring("topic") = "styleupdatedOK" then response.write "" response.write "" End If If request.querystring("topic") = "reviewOK" then response.write "" response.write "" End If response.write "" response.write "
Info:We are sorry our records show that you have already rated this link, we only allow one rating per visitor.

Click HERE to return to the directory.
Info:We are sorry our records show that you have already reviewed this link, we only allow one review per visitor.

Click HERE to return to the directory.
Info:Thanks for rating this item!

Click HERE to return to the directory.
Info:Thanks for reporting this error!

Click HERE to return to the directory.
Info:The configuration has been updated successfully!

Click HERE to return to the directory.
Info:The review has been deleted successfully!

Click HERE to return to the directory.
Info:The style has been updated successfully!

Click HERE to return to the directory.
Info:Thanks for reviewing this item!" If NeedApproval = "YES" then response.write "
Your review will be added after it is approved by the administrator." End If response.write "

Click HERE to return to the directory.
" 'RSz.Close 'Set RSz=Nothing End Sub '************************************************************************** '******** Review A Link '************************************************************************** Sub ReviewLink UserIPAddress = Request.ServerVariables("Remote_Addr") SQL = "Select * From Links Where LinkID = " & request.querystring("LinkID") & ";" set RSz=Server.CreateObject("adodb.Recordset") RSz.Open SQL, dbc, adopenstatic Call DrawTopNavigation response.write "aspWebLinks - Review A Link" response.write "
" response.write "" response.write "" response.write "
aspWebLinks - Review A Link
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Link Title:" & RSz("LinkTitle") & "
Rate this link on a scale from 1 to 5 (1 being the lowest, 5 being the highest):12345
Reviewer Name:
Review Title:
Review:
Email Address:
" RSz.Close Set RSz=Nothing End Sub '-------------------------------------------------------------------------- '-------- Review Execute '-------------------------------------------------------------------------- Sub ReviewExecute txtLinkID = Replace(Request.Form("txtLinkID"),chr(34),"'") txtRating = Replace(Request.Form("txtRating"),chr(34),"'") txtReviewBody = Replace(Request.Form("txtReviewBody"), chr(34),"'") txtReviewerName = Replace(Request.Form("txtReviewerName"), chr(34),"'") txtReviewTitle = Replace(Request.Form("txtReviewTitle"), chr(34),"'") txtEmailAddress = Replace(Request.Form("txtEmailAddress"),chr(34),"'") txtIPAddress = Request.Form("txtIPAddress") Set RSj=Server.CreateObject("ADODB.RecordSet") SQL = "Select * From Reviews WHERE LinkID=" & txtLinkID RSj.Open SQL, dbc, adOpenDynamic, adLockPessimistic, adCMDText AlreadyVoted = "FALSE" If NOT RSj.EOF then RSj.MoveFirst End If Do While NOT RSj.EOF If RSj("ReviewerIPAddress") = txtIPAddress then AlreadyVoted = "TRUE" End If RSj.MoveNext Loop If AlreadyVoted = "FALSE" then RSj.AddNew RSj("LinkID")=txtLinkID RSj("ReviewDate")=Date() RSj("ReviewRating")=txtRating RSj("ReviewerIPAddress")=txtIPAddress RSj("ReviewerEmailAddress")=txtEmailAddress RSj("ReviewerName")=txtReviewerName RSj("ReviewTitle")=txtReviewTitle RSj("ReviewBody")=txtReviewBody If NeedApproval = "YES" then RSj("ReviewLive") = 0 Else RSj("ReviewLive") = 1 End If RSj.Update RSj.Close Set RSj=Nothing response.redirect "links.asp?action=summary&topic=reviewOK&LinkID=" & txtLinkID Else response.redirect "links.asp?action=summary&topic=alreadyreviewed&LinkID=" & txtLinkID End If End Sub '************************************************************************** '******** Read Link Reviews '************************************************************************** Sub ReadReviews SQL = "Select * From Links Where LinkID = " & request.querystring("link") set RSz=Server.CreateObject("adodb.Recordset") RSz.Open SQL, dbc, adopenstatic Call DrawTopNavigation Call DrawLinks SQL = "Select * From Reviews Where LinkID = " & request.querystring("link") set RSr=Server.CreateObject("adodb.Recordset") RSr.Open SQL, dbc, adopenstatic Do Until RSr.EOF response.write "
" response.write "" 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 "" response.write "" response.write "" response.write "
" & RSr("ReviewBody") & "

" RSr.MoveNext Loop RSr.Close Set RSr=Nothing RSz.Close Set RSz=Nothing End Sub '************************************************************************** '******** Draw the Report Error Page '************************************************************************** Sub ReportError SQL = "Select * From Links Where LinkID = " & request.querystring("LinkID") & ";" set RSz=Server.CreateObject("adodb.Recordset") RSz.Open SQL, dbc, adopenstatic Call DrawTopNavigation response.write "aspWebLinks - Report An Error" response.write "
" response.write "" response.write "" response.write "
aspWebLinks - Report An Error
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Link Title:" & RSz("LinkTitle") & "
Email Address:
" RSz.Close Set RSz=Nothing End Sub '-------------------------------------------------------------------------- '-------- Report Error Process '-------------------------------------------------------------------------- Sub ReportErrorProcess txtEmailAddress = Replace(Request.Form("txtEmailAddress"),chr(34),"'") txtIPAddress = Request.Form("txtIPAddress") txtLinkID = request.form("txtLinkID") Set RSj=Server.CreateObject("ADODB.RecordSet") SQL = "Select * From Errors" RSj.Open SQL, dbc, adOpenDynamic, adLockPessimistic, adCMDText RSj.AddNew RSj("LinkID")=txtLinkID RSj("IPAddress")=txtIPAddress RSj("EmailAddress")=txtEmailAddress RSj.Update RSj.Close Set RSj=Nothing response.redirect "links.asp?action=summary&topic=errorOK&LinkID=" & txtLinkID End Sub '************************************************************************** '******** Approve Reviews '************************************************************************** Sub ApproveReviews If Session("LoggedIn") <> "YES" then response.redirect "links.asp" SQL = "Select * From Reviews Where ReviewLive = '0'" Set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic If RS.RecordCount <> 0 then RS.MoveFirst End If Call DrawTopNavigation response.write "aspWebLinks - Approve Reviews" response.write "
" response.write "" response.write "" response.write " <% RS.MoveNext Loop End If %>
aspWebLinks - Approve Reviews
" response.write "
" If RS.RecordCount = 0 then response.write "There are currently no reviews pending approval.
" Else Do While Not RS.EOF %>
"><%=RS("ReviewTitle")%> - <%=RS("ReviewBody")%> - Delete
<% RS.Close Set RS=Nothing %>
<% End Sub '-------------------------------------------------------------------------- '-------- Approve Reviews Process '-------------------------------------------------------------------------- Sub ApproveReviewsProcess If Session("LoggedIn") <> "YES" then response.redirect "links.asp" SQL = "Update Reviews Set ReviewLive = 1 WHERE LinkID IN("&request.form("toApprove")&")" Set RS = dbc.Execute(SQL) Set RS=Nothing if request.querystring("rd")="" then response.redirect "links.asp" else response.redirect "links.asp" end if End Sub '************************************************************************** '******** Review Errors '************************************************************************** Sub ReviewErrors If Session("LoggedIn") <> "YES" then response.redirect "links.asp" SQL = "Select * From Errors" Set RS=Server.CreateObject("adodb.Recordset") RS.Open SQL, dbc, adopenstatic If RS.RecordCount <> 0 then RS.MoveFirst End If Call DrawTopNavigation response.write "aspWebLinks - Review Errors" response.write "
" response.write "" response.write "" response.write " <% RS.MoveNext Loop End If %>
aspWebLinks - Review Errors
" response.write "
" If RS.RecordCount = 0 then response.write "There are currently no reported errors.
" Else Do While Not RS.EOF SQLb = "Select * From Links WHERE LinkID=" & RS("LinkID") Set RSb=Server.CreateObject("adodb.Recordset") RSb.Open SQLb, dbc, adopenstatic %>
">"><%=RSb("LinkTitle")%> - <%=RS("EmailAddress")%> - Delete
<% RS.Close Set RS=Nothing %>
<% End Sub '************************************************************************** '******** Delete Errors '************************************************************************** Sub ReviewErrorsProcess If Session("LoggedIn") <> "YES" then response.redirect "links.asp" if request.querystring("also") <> "clearerr" then SQL = "DELETE FROM Errors WHERE LinkID IN("& request.form("toApprove") &")" else SQL = "DELETE FROM Errors WHERE LinkID IN("& request.querystring("link") &")" end if Set RS = dbc.Execute(SQL) Set RS=Nothing if request.querystring("rd")="" then response.redirect "links.asp" else response.redirect "links.asp" end if End Sub '************************************************************************** '******** Delete Review '************************************************************************** Sub DeleteReview If Session("LoggedIn") <> "YES" then response.redirect "links.asp" SQL = "DELETE FROM Reviews WHERE ReviewID IN("& request.querystring("review") &")" Set RS = dbc.Execute(SQL) Set RS=Nothing if request.querystring("rd")="" then response.redirect "links.asp?action=summary&topic=deletereviewOK" else response.redirect "links.asp" end if End Sub '************************************************************************** '******** Draw the Modify Config Page '************************************************************************** Sub ModifyConfig SQL = "Select * From Config" set RSz=Server.CreateObject("adodb.Recordset") RSz.Open SQL, dbc, adopenstatic Call DrawTopNavigation response.write "aspWebLinks - Modify Configuration" response.write "
" response.write "" response.write "" response.write "
aspWebLinks - Modify Configuration
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
Administrative Password:
Number of Days New:
Number of Visits Hot:
Links Per Page:
Category Header:
Category Columns:
Sub Category Header:
Show Category Description:" response.write "YES" response.write "NO" response.write "
Show Whats New on home page:" response.write "YES" response.write "NO" response.write "
Number of New items on home page:
Show Whats Hot on home page:" response.write "YES" response.write "NO" response.write "
Require approval for link and review additions:" response.write "YES" response.write "NO" response.write "
Number of Hot items on home page:
Whats New Header:
Whats Hot Header:
Sort Links By:
" RSz.Close Set RSz=Nothing End Sub '-------------------------------------------------------------------------- '-------- Modify Config Process '-------------------------------------------------------------------------- Sub ModifyConfigProcess txtSortBy = request.form("txtSortBy") txtAdministrativePassword = request.form("txtAdministrativePassword") txtNumberOfDaysNew = request.form("txtNumberOfDaysNew") txtHotRating = request.form("txtHotRating") txtRecordsPerPage = request.form("txtRecordsPerPage") txtCategoryHeader = FixString(request.form("txtCategoryHeader")) txtCategoryCols = request.form("txtCategoryCols") txtSubCategoryHeader = FixString(request.form("txtSubCategoryHeader")) txtShowCatDescription = request.form("txtShowCatDescription") txtHowManyNew = request.form("txtHowManyNew") txtShowWhatsNew = request.form("txtShowWhatsNew") txtHowManyHot = request.form("txtHowManyHot") txtShowWhatsHot = request.form("txtShowWhatsHot") txtNeedApproval = request.form("txtNeedApproval") txtWhatsNewHeader = FixString(request.form("txtWhatsNewHeader")) txtWhatsHotHeader = FixString(request.form("txtWhatsHotHeader")) txtConfigID = request.form("txtConfigID") txtSkinName = request.form("txtSkinName") SQL="Update Config Set SortBy = '"&txtSortBy&"', AdministrativePassword = '"&txtAdministrativePassword&"', NumberOfDaysNew = '"&txtNumberOfDaysNew&"', HotRating = '"&txtHotRating&"', RecordsPerPage = '"&txtRecordsPerPage&"', CategoryHeader = '"&txtCategoryHeader&"', CategoryCols = '"&txtCategoryCols&"', SubCategoryHeader = '"&txtSubCategoryHeader&"', ShowCatDescription = '"&txtShowCatDescription&"', HowManyNew = '"&txtHowManyNew&"', ShowWhatsNew = '"&txtShowWhatsNew&"', HowManyHot = '"&txtHowManyHot&"', ShowWhatsHot = '"&txtShowWhatsHot&"', NeedApproval = '"&txtNeedApproval&"', WhatsNewHeader = '"&txtWhatsNewHeader&"', WhatsHotHeader = '"&txtWhatsHotHeader&"', SkinName = '"&txtSkinName&"' Where [ConfigID] ="&txtConfigID&"" response.write SQL dbc.Execute(SQL) response.redirect "links.asp?action=summary&topic=configupdatedOK" End Sub '************************************************************************** '******** Draw the Modify Style Page '************************************************************************** Sub ModifyStyle SQL = "Select * From Skins" set RSz=Server.CreateObject("adodb.Recordset") RSz.Open SQL, dbc, adopenstatic Call DrawTopNavigation response.write "aspWebLinks - Modify Style" response.write "
" response.write "" response.write "" response.write "
aspWebLinks - Modify Style
" response.write "
" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "" response.write "
LinkTableTag:
LinkHeaderBackColor:
LinkHeaderFontTag:
LinkHeaderButtonsFontTag:
DescriptionTableTag:
DescriptionFontTag:
LinkFooterBackColor:
LinkFooterFontTag:
NavigationTableTag:
NavigationFontTag:
CategoryTableTag:
CategoryFontTag:
CategorySmallFontTag:
CategoryHeaderBackColor:
CategoryHeaderFontTag:
TopNavigationTableTag:
TopNavigationFontTag:
SubCategoryHeaderBackColor:
SubCategoryHeaderFontTag:
SubCategoryTableTag:
SubCategoryFontTag:
MainCatCountFontTag:
SubCatCountFontTag:
WhatsNewHeaderBackColor:
WhatsNewHeaderFontTag:
WhatsNewTableTag:
WhatsNewFontTag:
WhatsNewLinkFontTag:
WhatsHotHeaderBackColor:
WhatsHotHeaderFontTag:
WhatsHotTableTag:
WhatsHotFontTag:
WhatsHotLinkFontTag:
AdminTableTag:
AdminHeaderBackColor:
AdminHeaderFontTag:
AdminFontTag:
WhatsNewFullTableTag:
WhatsHotFullTableTag:
PageHeader:
PageFooter:
" RSz.Close Set RSz=Nothing End Sub '-------------------------------------------------------------------------- '-------- Modify Style Process '-------------------------------------------------------------------------- Sub ModifyStyleProcess txtSkinFolder = request.form("txtSkinFolder") txtSkinName = request.form("txtSkinName") txtSkinID = request.form("txtSkinID") txtLinkTableTag = FixString(request.form("txtLinkTableTag")) txtLinkHeaderBackColor = FixString(request.form("txtLinkHeaderBackColor")) txtLinkHeaderFontTag = FixString(request.form("txtLinkHeaderFontTag")) txtLinkHeaderButtonsFontTag = FixString(request.form("txtLinkHeaderButtonsFontTag")) txtDescriptionTableTag = FixString(request.form("txtDescriptionTableTag")) txtDescriptionFontTag = FixString(request.form("txtDescriptionFontTag")) txtLinkFooterBackColor = FixString(request.form("txtLinkFooterBackColor")) txtLinkFooterFontTag = FixString(request.form("txtLinkFooterFontTag")) txtNavigationTableTag = FixString(request.form("txtNavigationTableTag")) txtNavigationFontTag = FixString(request.form("txtNavigationFontTag")) txtCategoryTableTag = FixString(request.form("txtCategoryTableTag")) txtCategoryFontTag = FixString(request.form("txtCategoryFontTag")) txtCategorySmallFontTag = FixString(request.form("txtCategorySmallFontTag")) txtCategoryHeaderBackColor = FixString(request.form("txtCategoryHeaderBackColor")) txtCategoryHeaderFontTag = FixString(request.form("txtCategoryHeaderFontTag")) txtTopNavigationTableTag = FixString(request.form("txtTopNavigationTableTag")) txtTopNavigationFontTag = FixString(request.form("txtTopNavigationFontTag")) txtSubCategoryHeaderBackColor = FixString(request.form("txtSubCategoryHeaderBackColor")) txtSubCategoryHeaderFontTag = FixString(request.form("txtSubCategoryHeaderFontTag")) txtSubCategoryTableTag = FixString(request.form("txtSubCategoryTableTag")) txtSubCategoryFontTag = FixString(request.form("txtSubCategoryFontTag")) txtMainCatCountFontTag = FixString(request.form("txtMainCatCountFontTag")) txtSubCatCountFontTag = FixString(request.form("txtSubCatCountFontTag")) txtWhatsNewHeaderBackColor = FixString(request.form("txtWhatsNewHeaderBackColor")) txtWhatsNewHeaderFontTag = FixString(request.form("txtWhatsNewHeaderFontTag")) txtWhatsNewTableTag = FixString(request.form("txtWhatsNewTableTag")) txtWhatsNewFontTag = FixString(request.form("txtWhatsNewFontTag")) txtWhatsNewLinkFontTag = FixString(request.form("txtWhatsNewLinkFontTag")) txtWhatsHotHeaderBackColor = FixString(request.form("txtWhatsHotHeaderBackColor")) txtWhatsHotHeaderFontTag = FixString(request.form("txtWhatsHotHeaderFontTag")) txtWhatsHotTableTag = FixString(request.form("txtWhatsHotTableTag")) txtWhatsHotFontTag = FixString(request.form("txtWhatsHotFontTag")) txtWhatsHotLinkFontTag = FixString(request.form("txtWhatsHotLinkFontTag")) txtAdminTableTag = FixString(request.form("txtAdminTableTag")) txtAdminHeaderBackColor = FixString(request.form("txtAdminHeaderBackColor")) txtAdminHeaderFontTag = FixString(request.form("txtAdminHeaderFontTag")) txtAdminFontTag = FixString(request.form("txtAdminFontTag")) txtWhatsNewFullTableTag = FixString(request.form("txtWhatsNewFullTableTag")) txtWhatsHotFullTableTag = FixString(request.form("txtWhatsHotFullTableTag")) txtPageHeader = FixString(request.form("txtPageHeader")) txtPageFooter = FixString(request.form("txtPageFooter")) SQL="Update Skins Set LinkTableTag = '"&txtLinkTableTag&"', LinkHeaderBackColor = '"&txtLinkHeaderBackColor&"', LinkHeaderFontTag = '"&txtLinkHeaderFontTag&"', LinkHeaderButtonsFontTag = '"&txtLinkHeaderButtonsFontTag&"', DescriptionTableTag = '"&txtDescriptionTableTag&"', DescriptionFontTag = '"&txtDescriptionFontTag&"', LinkFooterBackColor = '"&txtLinkFooterBackColor&"', LinkFooterFontTag = '"&txtLinkFooterFontTag&"', NavigationTableTag = '"&txtNavigationTableTag&"', NavigationFontTag = '"&txtNavigationFontTag&"', CategoryTableTag = '"&txtCategoryTableTag&"', CategoryFontTag = '"&txtCategoryFontTag&"', CategorySmallFontTag = '"&txtCategorySmallFontTag&"', CategoryHeaderFontTag = '"&txtCategoryHeaderFontTag&"', CategoryHeaderBackColor = '"&txtCategoryHeaderBackColor&"', TopNavigationTableTag = '"&txtTopNavigationTableTag&"', TopNavigationFontTag = '"&txtTopNavigationFontTag&"', SubCategoryHeaderBackColor = '"&txtSubCategoryHeaderBackColor&"', SubCategoryHeaderFontTag = '"&txtSubCategoryHeaderFontTag&"', SubCategoryTableTag = '"&txtSubCategoryTableTag&"', SubCategoryFontTag = '"&txtSubCategoryFontTag&"', MainCatCountFontTag = '"&txtMainCatCountFontTag&"', SubCatCountFontTag = '"&txtSubCatCountFontTag&"', WhatsNewHeaderBackColor = '"&txtWhatsNewHeaderBackColor&"', WhatsNewHeaderFontTag = '"&txtWhatsNewHeaderFontTag&"', WhatsNewTableTag = '"&txtWhatsNewTableTag&"', WhatsNewFontTag = '"&txtWhatsNewFontTag&"', WhatsNewLinkFontTag = '"&txtWhatsNewLinkFontTag&"', WhatsHotHeaderBackColor = '"&txtWhatsHotHeaderBackColor&"', WhatsHotHeaderFontTag = '"&txtWhatsHotHeaderFontTag&"', WhatsHotTableTag = '"&txtWhatsHotTableTag&"', WhatsHotFontTag = '"&txtWhatsHotFontTag&"', WhatsHotLinkFontTag = '"&txtWhatsHotLinkFontTag&"', AdminTableTag = '"&txtAdminTableTag&"', AdminHeaderBackColor = '"&txtAdminHeaderBackColor&"', AdminHeaderFontTag = '"&txtAdminHeaderFontTag&"', AdminFontTag = '"&txtAdminFontTag&"', WhatsNewFullTableTag = '"&txtWhatsNewFullTableTag&"', WhatsHotFullTableTag = '"&txtWhatsHotFullTableTag&"', PageHeader = '"&txtPageHeader&"', PageFooter = '"&txtPageFooter&"' Where [SkinID] ="&txtSkinID&"" response.write SQL dbc.Execute(SQL) response.redirect "links.asp?action=summary&topic=styleupdatedOK" End Sub '*********** Fix String Function ********************************************************* Function FixString(sValue) Dim sAns sAns = Replace(sValue, chr(34), "'") sAns = Replace(sValue, Chr(39), "''") sAns = Trim(sAns) if sAns="" then sAns=" " FixString = sAns End Function '************************************************************************** '******** End of Subs and Functions *************************************** '************************************************************************** Dim RS, SQL, Page, FirstLink, LastLink, TotalLinks, RSd, SQLd, Mode Mode = "TopCategories" If request.querystring("cat") <> "" then Mode = "CatView" Category = request.querystring("cat") End if If request.querystring("action") = "modifyconfig" then Mode = "ModifyConfig" End If If request.querystring("action") = "modifystyle" then Mode = "ModifyStyle" End If If request.querystring("action") = "modifyconfigprocess" then Mode = "ModifyConfigProcess" End If If request.querystring("action") = "modifystyleprocess" then Mode = "ModifyStyleProcess" End If If request.querystring("action") = "addlink" then Mode = "AddLink" End If If request.querystring("action") = "addprocess" then Mode = "AddProcess" End If If request.querystring("action") = "approvelinks" then Mode = "ApproveLinks" End If If request.querystring("action") = "addcategory" then Mode = "AddCategory" End If If request.querystring("action") = "addcatprocess" then Mode = "AddCatProcess" End If If request.querystring("action") = "approveprocess" then Mode = "ApproveProcess" End If If request.querystring("action") = "whatsnew" then Mode = "WhatsNew" End If If request.querystring("action") = "whatshot" then Mode = "WhatsHot" End If If request.querystring("action") = "search" then Mode = "Search" End If If request.querystring("action") = "searchexecute" then Mode = "SearchExecute" End If If request.querystring("action") = "ratelink" then Mode = "RateLink" End If If request.querystring("action") = "rateexecute" then Mode = "RateExecute" End If If request.querystring("action") = "reviewlink" then Mode = "ReviewLink" End If If request.querystring("action") = "reviewexecute" then Mode = "ReviewExecute" End If If request.querystring("action") = "readreviews" then Mode = "ReadReviews" End If If request.querystring("action") = "approvereviews" then Mode = "ApproveReviews" End If If request.querystring("action") = "approvereviewsprocess" then Mode = "ApproveReviewsProcess" End If If request.querystring("action") = "admin" then Mode = "Admin" End If If request.querystring("action") = "logoff" then Mode = "LogOff" End If If request.querystring("action") = "processlogin" then Mode = "ProcessLogin" End If If request.querystring("action") = "deletecategory" then Mode = "DeleteCategory" End If If request.querystring("action") = "deletelink" then Mode = "DeleteLink" End If If request.querystring("action") = "editcategory" then Mode = "EditCategory" End If If request.querystring("action") = "editlink" then Mode = "EditLink" End If If request.querystring("action") = "editlinkprocess" then Mode = "EditLinkProcess" End If If request.querystring("action") = "summary" then Mode = "Summary" End If If request.querystring("action") = "reporterror" then Mode = "ReportError" End If If request.querystring("action") = "reviewerrors" then Mode = "ReviewErrors" End If If request.querystring("action") = "deletereview" then Mode = "DeleteReview" End If If request.querystring("action") = "reviewerrorsprocess" then Mode = "ReviewErrorsProcess" End If If request.querystring("action") = "reporterrorprocess" then Mode = "ReportErrorProcess" End If If request.querystring("action") = "editcategoryprocess" then Mode = "EditCategoryProcess" End If If Mode = "TopCategories" then Category = 0 Call DrawTopNavigation Call DrawTopCategories If ShowWhatsNew = "YES" then Call WhatsNew End If If ShowWhatsHot = "YES" then Call WhatsHot End If End If If Mode = "CatView" then Call DrawTopNavigation Call DrawSubCategories Call DrawLinks End If If Mode = "ModifyConfig" then Category = 0 Call ModifyConfig End If If Mode = "ModifyConfigProcess" then Category = 0 Call ModifyConfigProcess End If If Mode = "ModifyStyle" then Category = 0 Call ModifyStyle End If If Mode = "ModifyStyleProcess" then Category = 0 Call ModifyStyleProcess End If If Mode = "AddLink" then Call AddLink End If If Mode = "AddProcess" then Call AddTheLink End If If Mode = "AddCategory" then Category = 0 Call AddACategory End If If Mode = "AddCatProcess" then Call AddTheCategory End If If Mode = "ApproveLinks" then Category = 0 Call ApproveLinks End If If Mode = "ApproveProcess" then Call ApproveProcess End If If Mode = "ApproveReviewsProcess" then Category = 0 Call ApproveReviewsProcess End If If Mode = "Summary" then Category = 0 Call Summary End If If Mode = "DeleteReview" then Category = 0 Call DeleteReview End If If Mode = "WhatsNew" then Category = 0 Call WhatsNewFull End If If Mode = "WhatsHot" then Category = 0 Call WhatsHotFull End If If Mode = "Search" then Category = 0 Call Search End If If Mode = "SearchExecute" then Category = 0 Call SearchExecute End If If Mode = "RateLink" then Category = 0 Call RateLink End If If Mode = "RateExecute" then Category = 0 Call RateExecute End If If Mode = "ReviewLink" then Category = 0 Call ReviewLink End If If Mode = "ReviewExecute" then Category = 0 Call ReviewExecute End If If Mode = "ReadReviews" then Category = 0 ReadingReview = "TRUE" Call ReadReviews End If If Mode = "ReportError" then Category = 0 Call ReportError End If If Mode = "ReviewErrors" then Category = 0 Call ReviewErrors End If If Mode = "ReviewErrorsProcess" then Category = 0 Call ReviewErrorsProcess End If If Mode = "ApproveReviews" then Category = 0 Call ApproveReviews End If If Mode = "ReportErrorProcess" then Category = 0 Call ReportErrorProcess End If If Mode = "Admin" then Category = 0 Call Login End If If Mode = "LogOff" then Call LogOff End If If Mode = "DeleteCategory" then Call DeleteCategory End If If Mode = "DeleteLink" then Call DeleteLink End If If Mode = "EditCategory" then Call EditCategory End If If Mode = "EditLink" then Call EditLink End If If Mode = "EditLinkProcess" then Call EditLinkProcess End If If Mode = "EditCategoryProcess" then Call EditCategoryProcess End If If Mode = "ProcessLogin" then Call ProcessLogin End If If request.querystring("gotolink") <> "" then Call GotoLink end if response.write PageFooter %>