<% ' Generic Database - Delete 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: ' 23 Mar 2000 - Skip display of BLOB's ' 17 Feb 2000 - Make Yes bold ' Changed default font string from "Verdana, Arial, Helvetica" to "Arial" to cut size ' 29 Oct 1999 - Added dbFooter, dbBodyTag, dbMenuTextColor ' 14 Jul 1999 - Added Response.Clear before Redirect for boneheaded MSIE browsers ' 9 Sep 1998 - First created or released Response.Buffer = True ' Check for an active session If Session("dbConn") & "x" = "x" Then Response.Clear Response.Redirect "GenericError.asp" End If ' Check user rights If Session("dbCanDelete") <> 1 Then Response.Clear Response.Redirect Session("dbViewPage") End If ' Get info from Session vars (kinda like parameters) strType = UCase(Session("dbType")) strConn = Session("dbConn") strFields = Session("dbFields") strTable = Session("dbRs") strDisplay = Session("dbDispView") strKeyField = Session("dbKey") strFont = Session("dbFont") intFontSize = Session("dbFontSize") strBorderColor = Session("dbBorderColor") strMenuColor = Session("dbMenuColor") strMenuTextColor = Session("dbMenuTextColor") intConfirmDelete = Session("dbConfirmDelete") if strFields & "x" = "x" Then strFields = "*" ' If we don't get passed a key to delete or there's no unique key field defined then get out. If (Request.QueryString("KEY").Count = 0) OR (strKeyField & "x" = "x") Then Response.Clear Response.Redirect Session("dbViewPage") Else strKey = Request.QueryString("KEY") Session("dbcurKey") = strKey End If DoConfirm = True If Request.QueryString("CMD").Count > 0 Then ' See if we need to confirm the deletion strCMD = Request.QueryString("CMD") If strCMD = "'CON'" Then DoConfirm = False End If ' Open Connection to the database set xConn = Server.CreateObject("ADODB.Connection") xConn.Open strConn ' Open Recordset and get the field info 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, 1, 2 intFieldCount = xrs.Fields.Count Dim aFields() ReDim aFields(intFieldCount,4) 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 xrs.Close strsql = "SELECT " & strFields & " FROM [" & strTable & "]" & " WHERE [" & aFields(strKeyField,1) & "]" & "=" & strKey If strType = "SQL" Then ' Strip brackets for SQL strsql = Replace(strsql,"[","") strsql = Replace(strsql,"]","") End If If strType = "SQL" Then xrs.Open strsql, xConn, 2, 3, 1 Else xrs.Open strsql, xConn, 2, 3 End If ' Get the field contents For x = 1 to intFieldCount aFields(x,4) = xrs(x-1) Next ' Check and set fonts and colours If Trim(strFont & "x" = "x") Then strFont = "Arial" If Not (intFontSize > 0) Then intFontSize = 2 If Trim(strBorderColor) & "x" = "x" Then strBorderColor = "#99CCCC" If Trim(strMenuColor) & "x" = "x" Then strMenuColor = "#99CCCC" If Trim(strMenuTextColor) & "x" = "x" Then strMenuTextColor = "Black" If (intConfirmDelete > 0) AND DoConfirm Then ' Prevent caching Response.ExpiresAbsolute = Now() - 1 Response.AddHeader "Cache-Control", "must-revalidate" Response.AddHeader "Cache-Control", "no-cache" %> <%=Session("dbTitle")%> - <%=txtDelete%> <% If Session("dbBodyTag") & "x" <> "x" Then Response.Write "" Else %> WIDTH="100%">
>
ALIGN="RIGHT" WIDTH="*"> "><%=txtBackToList%> <% If (Session("dbCanEdit") = 1) and Session("dbKey") > 0 Then %>   |   GenericEdit.asp?KEY=<%=aFields(Session("dbKey"),4)%>"><%=txtEdit%> <% End If %> <% If IsSubTable Then %>   |   GenericExit.asp?KEY=<%=aFields(Session("dbKey"),4)%>"><%=arrSubTable(0)%> <% End If %>
<%=Session("dbTitle")%> - <%=txtDelete%>

<%=txtDeletePrompt%>
>
>
GenericDelete.asp?CMD='CON'&KEY=<%= strKey %>"><%=txtYes%> "><%=txtNo%>
<% ' Display the page so far (flush buffer) Response.Flush %>

>
> <% For x = 1 to intFieldCount If Mid(strDisplay, x, 1) = "1" Then %> <% End If Next Set xrs = Nothing xConn.Close Set xConn = Nothing Else If xrs.EOF Then Response.Clear Response.Redirect Session("dbViewPage") End If xrs.Delete xrs.Close Set xrs = Nothing xConn.Close Set xConn = Nothing Response.Clear Response.Redirect Session("dbViewPage") End If %>
<% Response.Write aFields(x,1) %> <% curVal = aFields(x,4) ' Blank or null If IsNull(curVal) Then curVal = " " If aFields(x,2) = 205 Then curVal = " " ' Intercept BLOB's here, they don't like being compared to strings If Trim(curVal) & "x" = "x" Then curVal = " " ' 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 curVal = LT & "IMG SRC=" & QUOTE & curVal & QUOTE & " WIDTH=" & QUOTE & Session("dbMaxImageSize") & QUOTE & GT End If End If If curVal <> " " 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) case 11 ' Boolean If curVal Then curVal = txtTrue Else curVal = txtFalse End If case 129, 130, 200, 201, 202, 203 ' String or Memo curVal = replace(curVal,"<","<") curVal = replace(curVal,">",">") curVal = replace(curVal,chr(10)," 
") End Select end if Response.Write curVal %>

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