<%OPTION Explicit%>
<%
' Generic Database - Edit Record using Custom Template
' Notice: (c) 1998, 1999, 2000 Eli Robillard, All Rights Reserved.
' E-Mail: erobillard@ofifc.org
' URL: http://www.ofifc.org/Eli/ASP/GenericArticle.asp
' Template File Syntax
' - Create a Back link.
' - Place the named field (i.e. fldWhatever)
' - Place the Submit button.
' Only one of these tags (or the BACK tag pair) may appear on any given line.
' HTML, HEAD, TITLE, and BODY tags are not required in the template file. If they appear, all
' but the tag will be ignored. That way you can still set a background, trigger a java
' routine, whatever. Yes, client-side Javascript works in the template file for anything from
' form validation to timers. You can't use ASP though, nothing parsed in the template is passed
' back through ASP filter, it is all written with Response.Write's straight to the browser.
' Revision History:
' 19 Mar 2000 - Empty numbers now initialized to Null rather than 0, suggested by Trevor Gould
' Support to store to numeric fields using dbCombo lists
' 29 Feb 2000 - Fixed display of null strings
' 07 Feb 2000 - Improved display of quotation marks
' 21 Jan 2000 - OLEDB Connection Support
' 12 Oct 1999 - dbOnlyAdd = 1: Redirects to ExitPage after insertion
' dbOnlyEdit = 1: As above, also changes Back button to Exit
' 21 Jul 1999 - Fixed problem of having NAME in the field name
' 15 Apr 1998 - First created or released
' Var declaration
Dim aFields()
DIM Action, IsSubTable, pathroot, position, QUOTE, SkipToNext, SubmitValue, tlkprs, ts, x, y, z, tfld
DIM arrCombo, arrFieldNames, arrSubtable
DIM objFSO, xConn, xRs
DIM strConn, strCmd, strCombo, strComboDescDefault, strComboDescFldNo, strComboTable, strComboValueFldNo, strComboValueDefault, strDisplay, strFieldName, strFields, strFileName, strKey, strKeyField, strLeft, strLine, strLineU, strRight, strsql, strTable, strType, strDefault
DIM intFieldCount
' 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"
' Check for an active session
If Session("dbConn") & "x" = "x" Then
Response.Clear
Response.Redirect "GenericError.asp"
End If
' Get info from Session vars (kinda like parameters)
strType = Trim(UCase(Session("dbType")))
strConn = Session("dbConn")
strTable = Session("dbRs")
strFields = Session("dbFields")
strDisplay = Session("dbDispEdit")
strKeyField = Session("dbKey")
IsSubTable = Session("dbIsSubTable")
QUOTE = chr(34)
SubmitValue = "Update"
Action = "GET"
If Request.QueryString("KEY").Count > 0 Then
' Quick security check for Edit rights
If Not(Session("dbCanEdit") = 1) Then
Response.Clear
Response.Redirect Session("dbViewPage")
End If
strKey = Request.QueryString("KEY")
Session("dbcurKey") = strKey
Action = "GET"
ElseIf Request.QueryString("CMD").Count > 0 Then
' Quick security check for Add rights
If Not(Session("dbCanAdd") = 1) Then
Response.Clear
Response.Redirect Session("dbViewPage")
End If
strCMD = Request.QueryString("CMD")
If strCMD = "NEW" Then Action = "NEW"
Else
Action = Left(UCase(Request.Form("Action")),3)
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
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
Set xrs = Nothing
' Load the results of the last form view (GET or UPDATE)
For x = 1 to intFieldCount
aFields(x,4) = Request.Form(aFields(x,1))
Next
Select Case Action
Case "ADD" ' Insert the new record into the database
' Data validation
For x = 1 to intFieldCount
Select Case aFields(x, 2)
Case 2, 3, 4, 5, 6, 17' 2 Byte Integer, 4 Byte Integer, Currency
tFLD = aFields(x,4)
y = Null
If IsNumeric(tFLD) Then
aFields(x,4) = tFLD
Else
aFields(x,4) = y
End If
Case 11 ' Boolean True/False
If aFields(x,4) = "Yes" Then
aFields(x,4) = True
Else
aFields(x,4) = False
End If
Case 129, 130, 200, 201, 202, 204 ' Char, WChar, VarChar, LongVarChar (Memo), VarWChar (Unicode String), LongVarWChar
tFLD = Trim(aFields(x,4))
' Replace tag chars to secure against malicious html
tFLD = Replace(tFLD, "<", "<")
tFLD = Replace(tFLD, ">", ">")
If tFLD & "x" = "x" Then tFLD = Null
aFields(x,4) = tFLD
Case 7, 135 ' Date / Time Stamp, usually created with the Now() function
If (aFields(x,4) & "x" = "x") OR NOT IsDate(aFields(x,4)) Then
aFields(x,4) = Null
Else
aFields(x,4) = CDate(aFields(x,4))
End If
End Select
Next
Set xrs = Server.CreateObject("ADODB.Recordset")
' 2 for Open Dynamic, 3 for Optimistic Locking, 2 for Table
xrs.Open strTable, xConn, 2, 3, 2
xrs.AddNew
For x = 1 to intFieldCount
If x <> strKeyField Then xrs.Fields(x-1) = aFields(x,4)
Next
xrs.Update
xrs.Close
Set xrs = Nothing
xConn.Close
Set xConn = Nothing
Response.Clear
if Session("dbOnlyAdd") = 1 Then Response.Redirect Session("dbExitPage")
Response.Redirect Session("dbViewPage")
Case "NEW": ' Load a blank form
SUBMITVALUE = "Add"
' Initialize Fields
For x = 1 to intFieldCount
If strKeyField = aFields(x,1) Then
' Don't try to change the counter
Else
' Check if a default has been specified
strDefault = "dbDefault" & x
If Session(strDefault) & "x" = "x" Then
Select Case aFields(x, 2)
Case 2, 3, 4, 5, 6, 17, 131 ' Numeric types
aFields(x,4) = 0
Case 11 ' Boolean True/False
aFields(x,4) = "No"
Case 129, 130, 200, 201, 202, 203 ' String types
aFields(x,4) = ""
Case 7, 135 ' Date / Time Stamp
aFields(x,4) = ""
End Select
Else
aFields(x,4) = Session(strDefault)
End If
If IsSubTable Then
arrSubTable = Split(Session("dbSubTableCopy"),",")
If Trim(aFields(x,1)) = Trim(arrSubTable(2)) Then aFields(x,4) = Session("dbcurKey")
End If
End If
Next
Case "GET": ' Get a record to display
strsql = "SELECT " & strFields & " FROM [" & strTable & "] WHERE [" & aFields(strKeyField,1) & "]=" & strKey
If strType = "SQL" Then
' SQL databases do not allow spaces or brackets in table or field names
strsql = Replace(strsql,"[","")
strsql = Replace(strsql,"]","")
End If
set xrs = Server.CreateObject("ADODB.Recordset")
xrs.Open strsql, xConn
xrs.MoveFirst
If xrs.EOF Then
Response.Clear
Response.Redirect Session("dbViewPage")
End If
' Get the field contents
For x = 1 to intFieldCount
If aFields(x,2) = 11 Then
If xrs(x-1) Then
aFields(x,4) = "Yes"
Else
aFields(x,4) = "No"
End If
Else
aFields(x,4) = xrs(x-1)
End If
Next
xrs.Close
Set xrs = Nothing
Case "UPD": ' Update
' Open record
strsql = "SELECT " & strFields & " FROM [" & strTable & "] WHERE [" & aFields(strKeyField,1) & "]=" & Session("dbcurKey")
If strType = "SQL" Then
strsql = Replace(strsql,"[","")
strsql = Replace(strsql,"]","")
End If
set xrs = Server.CreateObject("ADODB.Recordset")
xrs.Open strsql, xConn, 1, 2
If xrs.EOF Then
Response.Clear
Response.Redirect Session("dbViewPage")
End If
For x = 1 to intFieldCount
If strKeyField = x Then
' Don't try to change the counter
Else
' Check if a forced update value has been specified
strDefault = "dbUpdateField" & x
If Session(strDefault) & "x" = "x" Then
Select Case aFields(x,2)
Case 2, 17 ' 2 Byte Integer, 1 Byte Integer
tFLD = aFields(x,4)
If IsNumeric(tFLD) Then
xrs(x-1) = CInt(tFLD)
Else
xrs(x-1) = Null
End If
Case 3 ' 4 Byte Integer
tFLD = aFields(x,4)
If IsNumeric(tFLD) Then
xrs(x-1) = CLng(tFLD)
Else
xrs(x-1) = Null
End If
Case 4 ' Single-Precision Floating Point
tFLD = aFields(x,4)
If IsNumeric(tFLD) Then
xrs(x-1) = CSng(tFLD)
Else
xrs(x-1) = Null
End If
Case 5, 6, 131 ' Double-Precision Floating Point, Currency, adNumeric
tFLD = aFields(x,4)
If IsNumeric(tFLD) Then
xrs(x-1) = CDbl(tFLD)
Else
xrs(x-1) = Null
End If
Case 11 ' Boolean True/False
tFLD = aFields(x,4)
If tFLD = "Yes" Then
xrs(x-1) = True
Else
xrs(x-1) = False
End If
Case 129, 130, 200, 201, 202, 203 ' String types
aFields(x,4) = Replace(aFields(x,4),chr(34),""")
tFLD = Trim(aFields(x,4))
If tFLD & "x" = "x" Then tFLD = Null
xrs(x-1) = tFLD
Case 7, 135 ' Date / Time Stamp, usually created with the Now() function
If IsDate(aFields(x,4)) Then
xrs(x-1) = CDate(aFields(x,4))
Else
xrs(x-1) = Null
End If
End Select
Else
xrs(x-1) = Session(strDefault)
End If
End If
Next
xrs.Update
xrs.Close
Set xrs = Nothing
xConn.Close
Set xConn = Nothing
Response.Clear
If Session("dbOnlyEdit") = 1 then Response.Redirect Session("dbExitPage")
Response.Redirect Session("dbViewPage")
End Select
%>
<%=Session("dbTitle")%> - <%=txtEditMode%>
", "",1,-1,1)
strLine = Replace(strLine, "","",1,-1,1)
strLine = Replace(strLine, "","",1,-1,1)
If Instr(1, strLineU, "") > 0 Then ' strip the header section
While Instr(1, strLineU, "") = 0
strLine = ts.ReadLine
strLineU = UCase(strLine)
Wend
SkipToNext = True
End If
If Not SkipToNext Then
if (Session("dbOnlyAdd")=1) OR (Session("dbOnlyEdit")=1) then
strLine = Replace(strLine, "", "",1,-1,1)
strLine = Replace(strLine, "", "",1,-1,1)
else
strLine = Replace(strLine, "", "",1,-1,1)
strLine = Replace(strLine, "", "",1,-1,1)
end if
strLine = Replace(strLine, "", "",1,-1,1)
strLine = Replace(strLine, "", "",1,-1,1)
strLine = Replace(strLine, "", "",1,-1,1)
position = Instr(1, strLineU, " 0 Then ' the line contains a Field
If position > 1 Then ' first display everything to the left of the field
strLeft = Left(strLine, position - 1)
strLine = Mid(strLine, position)
strLineU = UCase(strLine)
Response.Write strLeft
End If
' Find the end of the tag
position = Instr(1, strLine, ">")
If position = 0 Then ' the tag isn't properly terminated
Response.Write "Error: " & strLine & " "
Else ' display the field
If position < Len(RTrim(strLine)) Then ' get everything to the right
strRight = Mid(strLine, position + 1)
strLine = Left(strLine, position)
End If
' Strip everything except the values now -- NAME, etc.
strLine = Replace(strLine,"","")
strLine = Replace(strLine, chr(34), "") ' quotes
strLine = LTrim(strLine)
While Len(strLine) > 0 ' parse the values
if UCase(Left(strLine,4)) = "NAME" Then
strLine = Mid(strLine,5)
strLine = Replace(strLine,"=","")
strLine = LTrim(strLine)
strLineU = UCase("strLine")
position = Instr(1, strLine, " ")
if position = 0 Then
strFieldName = UCase(RTrim(strLine))
strLine = ""
else
strFieldName = UCase(Left(strLine, position - 1))
strLine = Mid(strLine, position + 1)
end if
else ' there's only NAME to check, if it's not there then something's wrong
Response.Write "Error: |" & strLine & "| "
strLine = ""
end if
Wend
' Go find the ordinal position of the field in the table structure
x = 0
y = 0
While y <= UBound(aFields)
If UCase(aFields(y, 1)) = strFieldName Then x = y
y = y + 1
Wend
if x = 0 Then
Response.Write "Error: " & strFieldName & " is not a field in this table."
Else
' Display the field
If Mid(strDisplay, x, 1) = "0" OR (strKeyField = x) OR Mid(strDisplay, x, 1) = "2" Then
If Mid(strDisplay, x, 1) = "2" Then
Response.Write aFields(x,4)
Response.Write ""
Else
Response.Write ""
End If
Else
If aFields(x,1) = "Password" Then %>
<% Else
Select Case aFields(x,2)
Case 2 ' 2-Byte Integer %>
<% Case 3 ' 4-Byte Integer %>
<% Case 4, 5, 131 ' Floating point %>
<% Case 6 ' Currency %>
<% Case 7, 135 ' Date / Time Stamp, usually created with the Now() function %>
<% Case 11 ' Boolean True/False %>
CHECKED<% End If %> VALUE="Yes"><%=txtTrue%>
CHECKED<% End If %> VALUE="No"><%=txtFalse%>
<% Case 17 ' 1-Byte Integer %>
<% Case 129, 130, 200, 202 ' String
strCombo = "dbCombo" & CStr(x)
If Trim(Session(strCombo)) & "x" = "x" Then ' normal string field
if NOT(aFields(x,4) & "x" = "x") then
aFields(x,4) = Replace(aFields(x,4),QUOTE,""")
aFields(x,4) = Replace(aFields(x,4),"<","<")
end if%>
<% Else ' Pull-down box
arrCombo = Split(Session(strCombo),",") %>
"
End If
Case 201, 203 ' Memo %>
<% End Select
End If
End If
' Display everything to the right of the field
Response.Write strRight & chr(13)
End If
End If
Else ' line does not contain a field
Response.Write strLine & chr(13)
End If
End If
Wend
xConn.Close
Set xConn = Nothing
%>
<% If Session("dbFooter") = 1 Then %>
<% End If %>