<%OPTION Explicit%> <% ' Generic Database - List Records ' Notice: (c) 1998, 1999, 2000 Eli Robillard, All Rights Reserved. ' E-Mail: erobillard@ofifc.org ' URL: http://www.ofifc.org/Eli/ASP/ ' Look out for: ' - Look out for: If two config files use the same dbRS, when jumping from one to the other the session vars won't be blanked. ' - Why: Session vars are reset on opening a new config file. Does so using dbRS to see if a different recordset is being opended. ' Revision History: ' 08 Jun 2000 - Excel view supported, use Session("dbExcel") = 1 ' Back button survives after session timeout ' 17 Mar 2000 - Display current search text in the search box ' Changed default font string from "Verdana, Arial, Helvetica" to "Arial" to cut size ' 08 Feb 2000 - Proper variable declarations, Option Explicit ' Flush cache after building header/menu/search ' dbFormatDateTime: 0=General, 1=LongDate, 2=ShortDate, 3=LongTime, 4=hh:mm ' 07 Feb 2000 - Optimised based on suggestions of Koos Bezemer ' 26 Jan 2000 - "Smart" page numbering for large recordsets ' Fixed page number font size on pgs 2+ ' 25 Jan 2000 - Fixed descending sort ' 21 Jan 2000 - dbCSV: Option to display tables as CSV (comma delimited) ' Support for OLEDB connections ' Testing fix for resorting JOINed recordsets ' 11 Nov 1999 - dbSearchAdvanced (=1) Field-by-field search originally developed by Grant Wilson, some mods ' dbSearchEnhanced (=1) Originally developed by Grant Wilson's, some mods ' 10 Nov 1999 - dbHeader, uses GenericHeader.asp ' 29 Oct 1999 - dbMenuTextColor, dbBodyTag ' dbFooter file changed from GenericFooter.inc to GenericFooter.asp ' 9 Sep 1998 - First created or released On Error Resume Next ' Declare vars DIM QUOTE, LT, GT DIM x, y, z, bgcolor, curPage, curRec, curVal, IsPrev, IsSubTable, NextStart, PrevStart, xConn, xField, xrs DIM aFields, arrFieldNames, arrSubTable DIM strBorderColor, strConn, strContainsURL, strDisplay, strEditor, strFieldNames, strFields, strFont, strFormatDate, strGroupBy, strHaving, strLine, strLink, strMenuColor, strMenuTextColor, strOrderBy, strPassThru, strSearchFields, strSearchText, strSearchPos, strsql, strTable, strTotalFields, strType, strURL, strViewer, strWhere DIM intActual, intAllowSort, intCount, intCSV, intDisplayRecs, intExcel, intFieldCount, intFontSize, intHidePageNumbers, intOrderBy, intPage, intPageDisp, intPrimary, intStartRec, intStopRec, intTotalRecs QUOTE = chr(34) LT = chr(60) GT = chr(62) intAllowSort = 1 bgcolor="#FFFFCC" ' Check for parameters, if we jump in another direction we need to pass them on strPassThru = "?" if Request.QueryString("START").Count > 0 Then strPassThru = strPassThru & "START=" & Request.Querystring("START") & "&" if Request.QueryString("ORDER").Count > 0 Then strPassThru = strPassThru & "ORDER=" & Request.Querystring("ORDER") & "&" if strPassThru = "?" then strPassThru = "" else strPassThru = Left(strPassThru,Len(strPassThru)-1) end if ' If a Template was identified, use the CustomList screen if Not(Session("dbListTemplate") & "x" = "x") Then Response.Clear Response.Redirect "GenericCustomList.asp" & strPassthru end If ' Quick security check, make sure we have an active session If Session("dbRs") & "x" = "x" Then Response.Clear Response.Redirect "GenericError.asp" End If ' Set editor to use for Add and Edit links If Session("dbEditTemplate") & "x" = "x" Then strEditor = "GenericEdit.asp" Else strEditor = "GenericCustomEdit.asp" End if ' Set viewer to use If Session("dbViewTemplate") & "x" = "x" Then strViewer = "GenericView.asp" Else strViewer = "GenericCustomView.asp" End if ' If this is the first time through, blank the vars. If Trim(Session("dbLastRs")) <> Trim(Session("dbRs")) Then Session("dbLastRs") = Session("dbRs") Response.Clear Response.Redirect Session("dbGenericPath") & "GenericExit.asp?CMD='Reset'" End If ' Get the settings from the Config File strType = UCase(Session("dbType")) strConn = Session("dbConn") strDisplay = Session("dbDispList") strSearchFields = Session("dbSearchFields") strSearchPos = UCase(Trim(Session("dbSearchPos"))) strTotalFields = Session("dbTotalFields") strFormatDate = Session("dbFormatDateTime") intCSV = Session("dbCSV") intExcel = Session("dbExcel") strFields = Session("dbFields") strTable = Session("dbRs") strWhere = Session("dbWhere") strGroupBy = Session("dbGroupBy") strHaving = Session("dbHaving") strOrderBy = Session("dbOrderBy") strFieldNames = Session("dbFieldNames") strSearchText = Session("dbSearchText") intOrderBy = Session("dbOrder") intPrimary = Session("dbKey") strFont = Session("dbFont") intFontSize = Session("dbFontSize") intHidePageNumbers = Session("dbHidePageNumbers") strBorderColor = Session("dbBorderColor") strMenuColor = Session("dbMenuColor") strMenuTextColor = Session("dbMenuTextColor") Session("ErrorNumber") = 0 ' Check and set fonts and colours If strFont & "x" = "x" Then strFont = "Arial" If Not(intFontSize > 0) Then intFontSize = 2 If strBorderColor & "x" = "x" Then strBorderColor = "#99CCCC" If strMenuColor & "x" = "x" Then strMenuColor = "#99CCCC" If strMenuTextColor & "x" = "x" Then strMenuTextColor = "Black" ' Other settings If NOT(Session("dbExitPageText") & "x" = "x") Then txtExit = Session("dbExitPageText") If strSearchPos <> "TOP" Then strSearchPos = "BOTTOM" ' Is a field list provided? If strFields & "x" = "x" Then strFields = "*" Session("dbFields") = "*" End If ' Is there a sub-table to display? If Not(Session("dbSubTable") & "x" = "x" ) Then arrSubTable = Split(Session("dbSubTable"),",") IsSubTable = True End If ' Set Records per Page intDisplayRecs = 10000 If Session("dbRecsPerPage") > 0 Then intDisplayRecs = Session("dbRecsPerPage") ' Check for a START parameter If Request.QueryString("START").Count > 0 Then intStartRec = Request.QueryString("START") Session("dbStartRec") = intStartRec Else ' Check for a StartRec variable in the Config File intStartRec = 1 If Session("dbStartRec") > 0 Then intStartRec = Session("dbStartRec") End If ' Check for an Order parameter If Request.QueryString("ORDER").Count > 0 Then ' Check if an ASC/DESC toggle is required (- for desc, + for asc) if abs(intOrderBy) = abs(Request.QueryString("ORDER")) then intOrderBy = 0 - intOrderBy else intOrderBy = Request.QueryString("ORDER") end if Session("dbOrder") = intOrderBy End If ' Set the last record to display intStopRec = intStartRec + intDisplayRecs - 1 ' Open Connection to the database set xConn = Server.CreateObject("ADODB.Connection") xConn.Open strConn ' Build query and open recordset strsql = "SELECT " & strFields & " FROM [" & strTable & "]" Select Case strType Case "UDF" strsql = "SELECT " & strFields & " FROM " & strTable Case "SQL" strsql = Replace(strsql,"[","") strsql = Replace(strsql,"]","") End Select If NOT strWhere & "x" = "x" Then strsql = strsql & " WHERE " & strWhere If NOT strGroupBy & "x" = "x" Then strsql = strsql & " GROUP BY " & strGroupBy If NOT strHaving & "x" = "x" Then strsql = strsql & " HAVING " & strHaving If intOrderBy <> 0 Then ' Order selected by clicking on column header or with dbOrder if intOrderBy > 0 then strsql = strsql & " ORDER BY " & intOrderBy else strsql = strsql & " ORDER BY " & abs(intOrderBy) & " DESC" end if Else ' Was a dbOrderBy string passed? If NOT strOrderBy & "x" = "x" Then strsql = strsql & " ORDER BY " & strOrderBy End If ' Run query set xrs = Server.CreateObject("ADODB.Recordset") xrs.Open strsql, xConn, 1, 2 If Err.Number <> 0 Then ' Call Error Handler if query bombs Session("ErrNumber") = Err.Number Session("ErrDesc") = Err.Description Session("ErrSource") = Err.Source Session("ErrLine") = Err.Line Session("ErrMsg") = "Query: " & strsql Response.Clear Response.Redirect "GenericError.asp" End If intFieldCount = xrs.Fields.Count intTotalRecs = xrs.RecordCount ' Get field info ReDim aFields(intFieldCount,4) If Trim(Session("dbFieldNames")) & "x" = "x" Then ReDim arrFieldNames(intFieldCount) For x = 1 to intFieldCount aFields(x, 1) = xrs.Fields(x-1).Name aFields(x, 2) = xrs.Fields(x-1).Type aFields(x, 3) = xrs.Fields(x-1).DefinedSize aFields(x, 4) = 0 ' For running totals (per dbTotalFields) arrFieldNames(x-1) = xrs.Fields(x-1).Name Next Else For x = 1 to intFieldCount aFields(x, 1) = xrs.Fields(x-1).Name aFields(x, 2) = xrs.Fields(x-1).Type aFields(x, 3) = xrs.Fields(x-1).DefinedSize aFields(x, 4) = 0 Next arrFieldNames = Split(Session("dbFieldNames"), ",") End If ' For settings not used, set to default values (i.e. "0000" or "111111") if trim(strTotalFields) & "x" = "x" then strTotalFields = String(intFieldCount,"0") if trim(strDisplay) & "x" = "x" then strDisplay = String(intFieldCount,"1") if trim(strFormatDate) & "x" = "x" then strFormatDate = String(intFieldCount,"0") %> LACEA Membership Directory

Please note: Information in this directory is to be used strictly for professional contacts only. Thank you for respecting our members’ privacy.










<% If Session("dbHeader") = 1 Then %> <% end if %> width="100%">
> <% If (Session("dbCanAdd") = 1) AND (Session("dbExtraAdd") = 1) Then %> <% End If %>
align="RIGHT" width="*"> <% if Trim(Session("dbExitPage")) & "x" <> "x" Then %> GenericExit.asp?EXIT='<%=Session("dbExitPage")%>'"><%=txtExit%> <% end if %>   |  GenericExit.asp?CMD='Reset'"><%=txtReset%>   |  GenericList.asp"><%=txtRefresh%> <% If Session("dbDebug") = 1 Then %>   |  GenericInfo.asp">db Info <% End If If Session("dbSearchAdvanced") = 1 Then %>   |  <%=txtAdvancedSearch%> <% End If If intCSV = 1 Then %>   |  <%=txtView%> CSV <% End If If intExcel = 1 Then %>   |  <%=txtView%> Excel <% End If If Session("dbCanAdd") = 1 Then %>   |  <%=txtAddRecord%> <% End If %>
<%=Session("dbTitle")%>
width="*"> <%=strEditor%>?CMD=NEW"><%=txtAddRecord%>

<% If strSearchPos = "TOP" Then DispSearch() ' Display the page so far (flush buffer) Response.Flush %> >
<% For x = 1 to intFieldCount ' If the field is to be displayed then If Mid(strDisplay, x, 1) = "1" Then strConn = "ORDER=" & x ' Don't display BLOB's as sortable, and a GROUP BY clause will throw sorting off (this is what sets intAllowSort) If (aFields(x,2) = 201) OR (aFields(x,2) = 203) OR (intAllowSort = 0) Then %> <% Else %> <% End If End If Next %> <% intCount = 0 intActual = 0 Do While (NOT xrs.EOF) AND (intCount < intStopRec) intCount = intCount + 1 If Cint(intCount) >= Cint(intStartRec) Then intActual = intActual + 1 %> <% x = 0 For Each xField in xrs.Fields x = x + 1 curVal = xField.Value ' Every other line will have a shaded background bgcolor="White" If intCount mod 2 = 0 Then bgcolor="#FFFFCC" ' If on the Key field, build the link used to load the Viewer, Editor, or Deleter If x = CInt(intPrimary) Then 'Session("zcurTable") = strTable 'Session("zcurDisplay") = strDisplay 'Session("zcurKeyField") = aFields(x,1) z = xField.Value Select Case aFields(x,2) Case 2, 3, 17 ' Integers strLink = "KEY=" & CStr(LTrim(z)) Case 130, 200, 202, 204 ' String, not Memo z = xField.Value z = Replace(z," ","%20") strLink = "KEY='" & CStr(LTrim(z)) & "'" End Select End If If Mid(strDisplay, x, 1) = "1" Then %> <% End If Next If IsSubTable Then %> <% End if If (Session("dbDispView") <> "") and Session("dbKey") > 0 Then %> <% End If If (Session("dbCanEdit") = 1) and Session("dbKey") > 0 Then %> <% End If If (Session("dbCanDelete") = 1) and Session("dbKey") > 0 Then %> <% End If %> <% End If xrs.MoveNext Loop ' Do we need to display a Totals row y = false For x = intFieldCount to 1 Step -1 If (Mid(strDisplay, x, 1) = "1") AND Mid(strTotalFields, x, 1) = "1" Then y = True If (Mid(strDisplay, x, 1) = "1") Then z = x ' z=first field displayed Next If y Then For x = 1 to intFieldCount if x = z then %> <% else If (Mid(strDisplay, x, 1) = "1") Then If Mid(strTotalFields, x, 1) = "1" Then Response.Write " " Else Response.Write " " End If End If end if Next Response.Write "" End If %>
<%=arrFieldNames(x-1)%><%=arrFieldNames(x-1)%>
Valign="TOP"> <% ' Empty / Null / Blank If IsNull(curVal) OR (Trim(curVal) & "x" = "x") Then curVal = " " Else If (Mid(strTotalFields, x, 1) = "1") AND IsNumeric(curVal) Then aFields(x,4) = aFields(x,4) + curVal End If ' Password If UCase(Left(aFields(x,1),8)) = "PASSWORD" Then curVal = "*****" ' Image If (UCase(Left(aFields(x,1),3)) = "IMG") Then If Session("dbMaxImageSize") = 0 Then curVal = LT & "IMG SRC=" & QUOTE & curVal & QUOTE & GT Else ' Opens image in a new window. Use Session("dbMaxImageSize") to set "thumbnail" size curVal = LT & "a href=" & QUOTE & curVal & QUOTE & "Target = _new> & QUOTE & txtClickToView & QUOTE & " & "" End If End If ' Check for E-mail address strContainsURL = "dbemailfor" & CStr(x) If (Session(strContainsURL) > 0) Then strURL = xrs(aFields(Session(strContainsURL),1)) If Trim(strURL) & "x" <> "x" Then strURL = Replace(strURL,"mailto:","") strURL = "mailto:" & LTrim(strURL) curVal = "" & curVal & "" End If End If ' Check for hyperlink strContainsURL = "dbURLfor" & CStr(x) If Session(strContainsURL) > 0 Then strURL = xrs(aFields(Session(strContainsURL),1)) If strURL & "x" <> "x" Then curVal = "" & curVal & "" ' *** Uncomment the following line to strip all #'s from hyperlink fields ' curVal = Replace(curVal,"#","") End If Else If (UCase(Left(curVal,7)) = "HTTP://") Then curVal = LT & "A href=" & QUOTE & curVal & QUOTE & GT & curVal & LT & "/A" & GT ' *** Uncomment the following line to strip all #'s from Access hyperlink fields ' curVal = Replace(curVal,"#","") End If End If Select Case aFields(x,2) case 2, 3, 17 ' Integers curVal = "
" & curVal & "
" case 4, 5 ' Reals curVal = "
" & curVal & "
" Case 6 ' Currency if curVal <> " " then curval = "
" & FormatCurrency(curval,2,-1) & "
" Case 11 ' Boolean If curVal Then curVal = txtTrue Else curVal = txtFalse End If Case 7, 135 ' Date / Time: 0=General, 1=LongDate, 2=ShortDate, 3=LongTime, 4=hh:mm if curVal <> " " then curVal = FormatDateTime(curVal, Mid(strFormatDate, x, 1)) Case 130, 201, 202, 203, 204 ' String or Memo curVal = replace(curVal,"<","<") curVal = replace(curVal,">",">") curVal = replace(curVal,chr(10)," 
") End Select Response.Write curVal %> 		 align="CENTER">GenericExit.asp?<%=strLink%>"><%=arrSubTable(0)%> align="CENTER">?<%=strLink%>"><%=txtView%> align="CENTER"><%=strEditor%>?<%=strLink%>"><%=txtEdit%> align="CENTER">GenericDelete.asp?<%=strLink%>"><%=txtDelete%>
align="RIGHT"> <%=txtTotal%>" & aFields(x,4) & " 
<% ' If no recs returned during a Search. . . If (intTotalRecs = 0) AND (Session("dbState") > 1) Then %>

<%=txtSearchFailMsgA%> GenericExit.asp?CMD='Reset'"><%=txtReset%> <%=txtSearchFailMsgB%>

<% End If ' See if there should be Backward or Forward Buttons on the table. intPageDisp = False If intStartRec = 1 Then isPrev = False Else isPrev = True PrevStart = intStartRec - intDisplayRecs If PrevStart < 1 Then PrevStart = 1 %>

[<< <%=txtPreviousPage%>] <% End If Response.Flush ' Display Page numbers If (intHidePageNumbers = 0) AND (isPrev OR (NOT xrs.EOF)) Then If (NOT isPrev) Then Response.Write "
" if (intTotalRecs / intDisplayRecs > 30) Then ' If there are lots of pages, use intelligent page numbers intPage = (intStartRec+intDisplayRecs-1) / intDisplayRecs strLine = "" & intPage & "" ' Build to the left of the current page marker x = 1 y = 1 curPage = intPage - y curRec = intStartRec - (intDisplayRecs*x*y) while curPage > 1 ' For every 5 page numbers displayed we increase spacing by a factor of 5 if (x mod 5) = 0 then y = y * 5 strLine = "" & curPage & " " & strLine curPage = curPage - y curRec = curRec - (intDisplayRecs*y) x = x + 1 wend ' Link to page 1 if intStartRec <> 1 then strLine = "1 " & strLine ' Build to the right of the current page marker x = 1 y = 1 curPage = intPage + y curRec = intStartRec + (intDisplayRecs*x*y) while curRec < intTotalRecs if (x mod 5) = 0 then y = y * 5 strLine = strLine & " " & curPage & "" curPage = curPage + y curRec = curRec + (intDisplayRecs*y) x = x + 1 wend ' Link to the last page if (curRec-(intDisplayRecs*y)) < (intTotalRecs-intDisplayRecs) then strLine = strLine & " " & clng(intTotalRecs / intDisplayRecs) & "" response.write strLine else ' There aren't too many pages so display them in the regular style x = 1 y = 1 While x <= intTotalrecs If clng(intStartRec) = clng(x) Then %> <%=y%> <% Else %> <%=y%> <% End If x = x + intDisplayRecs y = y + 1 Wend end If end if ' Next link If NOT xrs.EOF Then NextStart = intStartRec + intDisplayRecs %> [<%=txtNextPage%> >>] <% End If %>
<% If intStopRec > intCount Then intStopRec = intCount Response.Write txtRecords & " " & intStartRec & " " & txtTo & " " & intStopRec & " " & txtOf & " " & intTotalRecs ' Close recordset and connection xrs.Close Set xrs = Nothing xConn.Close Set xConn = Nothing %>

<% If strSearchPos = "BOTTOM" Then DispSearch() End If %> <% If Session("dbFooter") = 1 Then %> <% End If %>



<% Function DispSearch If strSearchFields & "x" <> "x" Then ' If in a search, ask for a reset before another search. If Session("dbState") = 3 Then %>
GenericExit.asp?CMD='Reset'"><%=txtReset%> <%=txtSearchFailMsgB%>
<% Else %> >
>
<%=txtSearchFor%> <% If Session("dbSearchEnhanced") = 1 then%>
<%=txtAnyofthesewords%> <%=txtExactPhrase%> <% Else %> <% End If %>

<% End If End If End Function %>