<% ' Generic Database - View Record ' Notice: (c) 1998, 1999, 2000 Eli Robillard, All Rights Reserved. ' E-Mail: erobillard@ofifc.org ' URL: http://www.ofifc.org/Eli/ASP/ ' Revision History: ' 17 Mar 2000 - Changed default font string from "Verdana, Arial, Helvetica" to "Arial" to cut size ' 13 Mar 2000 - Display lookup values if a combo box is defined by list or table ' 16 Feb 2000 - Swapped check for URL/E-mail to after Select...Case so links are shown right ' 08 Feb 2000 - Translate < and > to < and > to remove embedded html security hole ' dbFormatDateTime: 0=General, 1=LongDate, 2=ShortDate, 3=LongTime, 4=hh:mm ' 21 Jan 2000 - OLEDB Connection Support ' 29 Oct 1999 - Added dbMenuTextColor, dbBodyTag ' Changed footer file from GenericFooter.inc to GenericFooter.asp ' 21 Jul 1999 - Fix for null dates ' 23 Jun 1999 - Option to strip #'s from hyperlink fields, search for *** and uncomment the code ' 9 Sep 1998 - First created or released ' Prevent caching Response.Buffer = True Response.ExpiresAbsolute = Now() - 1 Response.AddHeader "cache-control", "must-revalidate" Response.AddHeader "cache-control", "private" Response.AddHeader "pragma", "no-cache" ' Declare vars DIM aFields(), arrSubTable(), QUOTE, LT, GT, IsSubTable, IsLink DIM strType, strConn, strTable, strFormatDate, strFont, strBorderColor, strMenuColor, strMenuTextColor DIM intFontSize QUOTE = chr(34) LT = chr(60) GT = chr(62) ' Make sure we have an active session If Session("dbRs") = "" Then Response.Clear Response.Redirect "GenericError.asp" End If ' Check permissions If Session("dbDispView") = "" Then Response.Clear Response.Redirect Session("dbViewPage") End If ' Get info from Session vars strType = UCase(Session("dbType")) strConn = Session("dbConn") strTable = Session("dbRs") strFormatDate = Session("dbFormatDateTime") strFont = Session("dbFont") intFontSize = Session("dbFontSize") strBorderColor = Session("dbBorderColor") strMenuColor = Session("dbMenuColor") strMenuTextColor = Session("dbMenuTextColor") ' Is there a sub-table to display If Not (Session("dbSubTable") = "") Then arrSubTable = Split(Session("dbSubTable"),",") IsSubTable = True End If ' Check for and set default fonts / colors If Trim(strFont) = "" Then strFont = "Arial" If Not (intFontSize > 0) Then intFontSize = 2 If Trim(strBorderColor) = "" Then strBorderColor = "#99CCCC" If Trim(strMenuColor) = "" Then strMenuColor = "#99CCCC" If Trim(strMenuTextColor) = "" Then strMenuTextColor = "Black" ' Check which editor to use for Add and Edit links If Session("dbEditTemplate") & "x" = "x" Then strEditor = "GenericEdit.asp" Else strEditor = "GenericCustomEdit.asp" End if ' Get the key value of the record to display If Request.QueryString("KEY").Count > 0 Then strKey = Request.QueryString("KEY") Session("dbcurKey") = strKey Else Response.Clear Response.Redirect Session("dbViewPage") End If ' Get info from Session vars (kinda like parameters) strTable = Session("dbRs") strDisplay = Session("dbDispView") strKeyField = Session("dbKey") strFields = Session("dbFields") if strFields = "" Then strFields = "*" ' Open Connection to the database set xConn = Server.CreateObject("ADODB.Connection") xConn.Open strConn ' Open Recordset and get field info and key field name 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 set xrs = Server.CreateObject("ADODB.Recordset") xrs.Open strsql, xConn intFieldCount = xrs.Fields.Count 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 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 Next arrFieldNames = Split(Session("dbFieldNames"), ",") End If xrs.Close ' Select the chosen record strsql = "SELECT " & strFields & " FROM [" & strTable & "]" strsql = strsql & " WHERE [" & aFields(strKeyField,1) & "]" & "=" & strKey Select Case strType Case "UDF" strsql = "SELECT " & strFields & " FROM " & strTable strsql = strsql & " WHERE [" & aFields(strKeyField,1) & "]" & "=" & strKey Case "SQL" strsql = Replace(strsql,"[","") strsql = Replace(strsql,"]","") End Select xrs.Open strsql, xConn If xrs.EOF Then ' Record not found Response.Clear Response.Redirect Session("dbViewPage") End If For x = 1 to intFieldCount ' Get the field contents aFields(x,4) = xrs(x-1) Next xrs.Close Set xrs = Nothing xConn.Close Set xConn = Nothing ' For settings not used, set to default values (i.e. "0000" or "111111") if trim(strFormatDate) = "" then strFormatDate = String(intFieldCount,"0") %> LACEA Membership Directory










<% If Session("dbHeader") = 1 Then %> <% End If %> WIDTH="100%">
>
ALIGN="RIGHT" WIDTH="*"> GenericList.asp"><%=txtBackToList%> <% If (Session("dbCanEdit") = 1) and Session("dbKey") > 0 Then %>   |  <%=strEditor%>?KEY=<%=aFields(Session("dbKey"),4)%>"><%=txtEdit%> <% End If If IsSubTable Then %>   |  GenericExit.asp?KEY=<%=aFields(Session("dbKey"),4)%>"><%=arrSubTable(0)%> <% End If %>
<%=Session("dbTitle")%> - <%=txtView%>

>
> <% For x = 1 to intFieldCount If Mid(strDisplay, x, 1) = "1" Then %> <% End If Next %>
<%=arrFieldNames(x-1)%> <% curVal = aFields(x,4) ' Blank / Null / Empty If IsNull(curVal) OR (Trim(curVal) & "x" = "x") Then curVal = " " ' Password If UCase(Left(aFields(x,1),8)) = "PASSWORD" Then curVal = "*****" ' Format the various field types ' See if the field is an alias for another description (from dbCombo) strCombo = "dbCombo" & CStr(x) If Trim(Session(strCombo)) & "x" = "x" Then Select Case aFields(x,2) case 2, 3, 4, 5 ' Numbers curVal = "
" & curVal & "
" case 6 ' Currency curval = "
" & FormatCurrency(curval,2,-1) & "
" case 7, 135 ' Date / Time - Fixed for Null values by Elizabeth Robins if curVal <> " " then curVal = FormatDateTime(curVal, Mid(strFormatDate, x, 1)) case 11 ' Boolean If curVal Then curVal = txtTrue Else curVal = txtFalse End If case 129, 130, 200, 201, 202, 203 ' String or Memo IsLink = False ' Image If (UCase(Left(aFields(x,1),3)) = "IMG") Then IsLink = True If Session("dbMaxImageSize") = 0 Then curVal = LT & "IMG SRC=" & QUOTE & curVal & QUOTE & GT Else curVal = LT & "IMG SRC=" & QUOTE & curVal & QUOTE & " WIDTH=" & QUOTE & Session("dbMaxImageSize") & QUOTE & GT End If End If ' Check for E-mail address strContainsURL = "dbEMailfor" & CStr(x) If (Session(strContainsURL) > 0) Then IsLink = True strURL = aFields(Session(strContainsURL),4) 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 IsLink = True strURL = aFields(Session(strContainsURL),4) 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 IsLink = True 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 if NOT IsLink then curVal = replace(curVal,"<","<") curVal = replace(curVal,">",">") end if curVal = replace(curVal,chr(10)," 
") End Select else ' Look up the value to display arrCombo = Split(Session(strCombo),",") ' LIST If Trim(UCase(arrCombo(0))) = "LIST" Then curVal = "" y = 1 While y < UBound(arrCombo) arrCombo(y) = LTrim(arrCombo(y)) arrCombo(y+1) = LTrim(arrCombo(y+1)) if arrCombo(y) = LTrim(aFields(x,4)) then curVal = arrCombo(y+1) y = uBound(arrCombo) end if y = y + 2 wend End If ' TABLE If (Trim(UCase(arrCombo(0))) = "TABLE") OR (Trim(UCase(arrCombo(0))) = "TBL") Then strComboTable = Trim(arrCombo(1)) strComboValueFldNo = CInt(arrCombo(2))-1 strComboDescFldNo = CInt(arrCombo(3))-1 strsql = "SELECT * FROM [" & strComboTable & "]" If strType = "SQL" Then strsql = Replace(strsql,"[","") strsql = Replace(strsql,"]","") End If set xConn = Server.CreateObject("ADODB.Connection") xConn.Open strConn set tlkpRs = Server.CreateObject("ADODB.Recordset") tlkpRs.Open strsql, xConn, 1, 2 select case tlkpRs.Fields(strComboValueFldNo).Type case 2, 3, 4, 5, 6 ' Numbers, Currency tlkpRs.Find tlkpRs.Fields(strComboValueFldNo).Name & " = " & aFields(x,4), 0 case 11 ' Boolean tlkpRs.Find tlkpRs.Fields(strComboValueFldNo).Name & " = " & aFields(x,4), 0 case 129, 130, 200, 201, 202, 203 ' String or Memo tlkpRs.Find tlkpRs.Fields(strComboValueFldNo).Name & " LIKE '" & curVal & "'", 0 end select if not tlkpRs.EOF then curval = tlkpRs.Fields(strComboDescFldNo) tlkpRs.Close Set tlkpRs = Nothing xConn.Close Set xConn = Nothing end if end if Response.Write curVal %>
<% If Session("dbFooter") = 1 Then %> <% End If %>