<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%> <% '============================================================= ' ASP Reciprocal Link Exchange LITE / PROFESSIONAL / ULTIMATE ' ©2007 wsdw.co.uk - Web Site Design World - www.wsdw.co.uk '============================================================= ' All rights reserved. ' Use of this code is covered by the terms and ' conditions in the license agreement. No ' unauthorized duplication or distribution is ' permitted. wsdw.co.uk's copyright notices must ' remain in the ASP sections of the code. '============================================================= '--------------------------------------- ' CATEGORIES '--------------------------------------- Dim rsCat__MMColParam rsCat__MMColParam = "1" If (Request.QueryString("1") <> "") Then rsCat__MMColParam = Request.QueryString("1") End If %> <% Dim rsCat Dim rsCat_numRows Set rsCat = Server.CreateObject("ADODB.Recordset") rsCat.ActiveConnection = strJETConn rsCat.Source = "SELECT *,(SELECT COUNT(LEID) FROM LinkExchange WHERE LinkExchange.SiteCategory = Categories.CID AND LinkExchange.Approved = 1)AS CategoryCount FROM Categories WHERE ParentID = 0 ORDER BY CatOrder ASC" rsCat.CursorType = 0 rsCat.CursorLocation = 2 rsCat.LockType = 1 rsCat.Open() rsCat_numRows = 0 '--------------------------------------- ' SUB CATEGORIES '--------------------------------------- If Application(COMPANYNAME & "DisplaySubCatTotal") <> "off" Then set rsSub = Server.CreateObject("ADODB.Recordset") rsSub.ActiveConnection = strJETConn rsSub.Source = "SELECT * FROM Categories WHERE ParentID <> 0 ORDER BY CatOrder ASC" rsSub.CursorType = 0 rsSub.CursorLocation = 2 rsSub.LockType = 3 rsSub.Open() rsSub_numRows = 0 End If '--------------------------------------- ' GET FIRST WORD OF STRING '--------------------------------------- Function GetFirstWord(str) Dim CatName, CatLen CatName = Trim(str) If InStr(1,CatName, " ") > 0 Then CatLen = InStr(1, CatName, " ") CatName = Left(CatName, CatLen) Response.Write(Trim(CatName)) Else Response.Write(Trim(Left(CatName, 12))) End if End Function Dim HLooper1__numRows HLooper1__numRows = -2 Dim HLooper1__index HLooper1__index = 0 rsCat_numRows = rsCat_numRows + HLooper1__numRows ' *** Go To Record and Move To Record: create strings for maintaining URL and Form parameters ' create the list of parameters which should not be maintained MM_removeList = "&index=" If (MM_paramName <> "") Then MM_removeList = MM_removeList & "&" & MM_paramName & "=" MM_keepURL="":MM_keepForm="":MM_keepBoth="":MM_keepNone="" ' add the URL parameters to the MM_keepURL string For Each Item In Request.QueryString NextItem = "&" & Item & "=" If (InStr(1,MM_removeList,NextItem,1) = 0) Then MM_keepURL = MM_keepURL & NextItem & Server.URLencode(Request.QueryString(Item)) End If Next ' add the Form variables to the MM_keepForm string For Each Item In Request.Form NextItem = "&" & Item & "=" If (InStr(1,MM_removeList,NextItem,1) = 0) Then MM_keepForm = MM_keepForm & NextItem & Server.URLencode(Request.Form(Item)) End If Next ' create the Form + URL string and remove the intial '&' from each of the strings MM_keepBoth = MM_keepURL & MM_keepForm if (MM_keepBoth <> "") Then MM_keepBoth = Right(MM_keepBoth, Len(MM_keepBoth) - 1) if (MM_keepURL <> "") Then MM_keepURL = Right(MM_keepURL, Len(MM_keepURL) - 1) if (MM_keepForm <> "") Then MM_keepForm = Right(MM_keepForm, Len(MM_keepForm) - 1) ' a utility function used for adding additional parameters to these strings Function MM_joinChar(firstItem) If (firstItem <> "") Then MM_joinChar = "&" Else MM_joinChar = "" End If End Function '----------------------------------------------- ' GET TEMPLATE FILE '----------------------------------------------- Call ReadTemplateFILE(TemplatePath,aTemplatePage,"Directory") %> Directory <% '----------------------------------------------- ' WRITE TEMPLATE PAGE FIRST ARRAY '----------------------------------------------- response.write(aTemplatePage(0)) %> <% startrw = 0 endrw = HLooper1__index numberColumns = Application(COMPANYNAME & "DisplayCatColumns")' CATS numrows = -1 while((numrows <> 0) AND (Not rsCat.EOF)) startrw = endrw + 1 endrw = endrw + numberColumns %> <% While ((startrw <= endrw) AND (Not rsCat.EOF)) %> <% startrw = startrw + 1 rsCat.MoveNext() Wend %> <% numrows=numrows-1 Wend %>
"><%=(rsCat.Fields.Item("Category").Value)%> <% If Application(COMPANYNAME & "DisplayLinksTotal") = "on" then%> (<%=(rsCat.Fields.Item("CategoryCount").Value)%>) <% End If %>
<% If Application(COMPANYNAME & "DisplaySubCatTotal") = "on" Then Dim rsSub__numRows rsSub__numRows = 3 ' SUB CATS Dim rsSub__index rsSub__index = 0 rsSub_numRows = rsSub_numRows + rsSub__numRows rsSub.Filter = "ParentID = " & rsCat.Fields.Item("CID").Value %> <% While ((rsSub__numRows <> 0) AND (NOT rsSub.EOF)) %>"><%= GetFirstWord(rsSub.Fields.Item("Category").Value)%><% If rsSub__index - 1 > 0 Then %>...<% Else %>, <% End If %><% rsSub__index=rsSub__index+1 rsSub__numRows=rsSub__numRows-1 rsSub.MoveNext() Wend End If %>

Directory Search



Powered by Reciprocal Link Exchange Professional by wsdw.co.uk
<% rsCat.Close() Set rsCat = Nothing If Application(COMPANYNAME & "DisplaySubCatTotal") = "on" Then rsSub.Close() Set rsSub = Nothing End If %> <% '----------------------------------------------- ' WRITE TEMPLATE PAGE LAST ARRAY '----------------------------------------------- response.write(aTemplatePage(1)) %>