<%@ LANGUAGE = "VBScript" %>
<%
'***********************************************
' UTE - (U)niversal ASP (T)able (E)ditor
'***********************************************
' UTE_FORM.ASP Rev.: 1.4
' Form script
'
' (c) in 2000-2001 by Tom Wellige
' http://www.wellige.com , tom@wellige.com
'
' You may use and alter this script as long as
' you put this original header in it !
'
'***********************************************
%>
<!--#include file ="ute.inc"-->
<%
' if not called from valid ute.asp session quit
if Not Session("bValid") then
WriteHTMLHeader "Edit Error"
Response.Write("Error: No Table specified !")
WriteHTMLFooter
Response.End
end if
dim rsUpdate
' setup error management
Dim nErrors
Dim ErrorField()
Dim ErrorNumber()
Dim ErrorMessage()
nErrors = 0
' if Cancel-Button was previously clicked goto Startpage
if Request.Form(sFormPre & "cancel" & sFormPost) = sFormCancelButton then
Response.Redirect sUteASP
end if
RequestParameter
Set db = Session("db")
Set rs = Session("rs")
sTableName = Session("sTableName")
nMode = 0
nRecord = 0
' is this the first call "recall" due to clicking the Ok-Button
bFormSubmit = (Request.Form(sFormPre & "ok" & sFormPost) = sFormOkButton)
if not bFormSubmit then
' first call
if Request.QueryString(sParamMode) <> "" then
nMode = CInt(Request.QueryString(sParamMode))
end if
if Request.QueryString(sParamRecord) <> "" then
nRecord = CInt(Request.QueryString(sParamRecord))
end if
Session("nMode") = nMode
Session("nRecord") = nRecord
else
' ok button call
nMode = Session("nMode")
nRecord = Session("nRecord")
nErrors = 0
Redim ErrorField(0)
Redim ErrorNumber(0)
Redim ErrorMessage(0)
end if
' valid mode ? (Insert, Edit, Delete)
if nMode = 0 then
WriteHTMLHeader "Edit Error"
Response.Write("Error: No Mode specified !")
WriteHTMLFooter
Response.End
end if
' valid record number ? (if Edit or Delete Mode)
if (nMode <> mdInsert) and (nRecord = 0) then
WriteHTMLHeader "Edit Error"
Response.Write("Error: No Record specified !")
WriteHTMLFooter
Response.End
end if
' get RecordSet for this form
if nMode = mdInsert then
' create new RecordSet
set rsForm = Server.CreateObject("ADODB.Recordset")
rsForm.Open sTableName, db, adOpenKeyset, adLockOptimistic, adCmdTable
rsForm.AddNew
else
' get RecordSet from Session
rs.Move nRecord - 1, adBookmarkFirst
Set rsForm = rs
end if
' do any update actions
if bFormSubmit then
select case nMode
case mdInsert
' Insert New Record
set rsUpdate = Server.CreateObject("ADODB.Recordset")
rsUpdate.Open sTableName, db, adOpenKeyset, adLockOptimistic, adCmdTable
rsUpdate.AddNew
UpdaterecordSet rsUpdate
case mdEdit
' Edit a specific Record
sSQL = "SELECT * FROM " & sTableName
if PrimaryKeyFieldsCount > 0 then
' use Primary Keys for identification
ic = 1
bFirst = True
do while ic <= PrimaryKeyFieldsCount
set curField = rsForm(PrimaryKeyFields(ic))
if not IsExcluded(curField.Type) then
sSQL = sSQL & AddWhere (curField, bFirst)
bFirst = False
end if
ic = ic + 1
loop
else
' use all fields for identification
ic = 1
bFirst = True
do while ic <= StandardFieldsCount
set curField = rsForm(StandardFields(ic))
if not IsExcluded(curField.Type) then
sSQL = sSQL & AddWhere (curField, bFirst)
bFirst = False
end if
ic = ic + 1
loop
end if
set rsUpdate = Server.CreateObject("ADODB.Recordset")
rsUpdate.Open sSQL, db, adOpenDynamic, adLockOptimistic, adCmdText
UpdaterecordSet rsUpdate
case mdDelete
' Delete Record
sSQL = "DELETE FROM " & sTableName
if PrimaryKeyFieldsCount > 0 then
' use Primary Keys for identification
ic = 1
bFirst = True
do while ic <= PrimaryKeyFieldsCount
set curField = rsForm(PrimaryKeyFields(ic))
if not IsExcluded(curField.Type) then
sSQL = sSQL & AddWhere (curField, bFirst)
bFirst = False
end if
ic = ic + 1
loop
else
' use all fields for identification
ic = 1
bFirst = True
do while ic <= StandardFieldsCount
set curField = rsForm(StandardFields(ic))
if not IsExcluded(curField.Type) then
sSQL = sSQL & AddWhere (curField, bFirst)
bFirst = False
end if
ic = ic + 1
loop
end if
db.Execute(sSQL)
end select
' If everything is ok go to Startpage.
' With passing the sort parameters a complete reload is enforced.
if nErrors = 0 then
Response.Redirect sUteAsp & "?" & sParamSort & "=" & sSort & "&" & sParamSortDir & "=" & sSortDir
end if
end if
Session("bViewDefinitions") = bViewDefinitions
sTitle = UCase(sTableName)
select case nMode
case mdEdit
sSubTitle = "Edit Record"
case mdInsert
sSubTitle = "Insert Record"
case mdDelete
sSubTitle = "Delete Record"
end select
' --- Adds WHERE clause to SQL Statement ---
Function AddWhere ( byref feld, bFirst )
sSepChar = ""
select case feld.type
case adBSTR, adVariant, adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar
sSepChar = "'"
case adDate, adDBDate, adDBTime, adDBTimeStamp
sSepChar = "#"
case else
sSepChar = ""
end select
if bFirst then
sReturn = " WHERE "
else
sReturn = " AND "
end if
if IsNull(feld.value) then
if bFirst then
AddWhere = " WHERE 0=0 "
else
AddWhere = ""
end if
else
sValue = CStr(feld.value)
select case feld.type
case adSingle, adDouble, adCurrency
sValue = Replace(sValue, ",", ".")
case adBoolean
if feld.value then
sValue = "True"
else
sValue = "False"
end if
case adBSTR, adVariant, adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar
sValue = Replace(sValue, "'", "''")
end select
AddWhere = sReturn & feld.name & " = " & sSepChar & sValue & sSepChar
end if
End Function
' --- Is this an Error Field ? ---
Function IsErrorField ( sName )
Dim bReturn
bReturn = False
if nErrors > 0 then
for ia = 1 to nErrors
if ErrorField(ia) = sName then bReturn = True
next
end if
IsErrorField = bReturn
End Function
' --- Returns the Error Description ---
Function GetErrorNumber ( sName )
Dim sReturn
sReturn = ""
if nErrors > 0 then
for ib = 1 to nErrors
if ErrorField(ib) = sName then sReturn = CStr(ErrorNumber(ib))
next
end if
GetErrorNumber = sReturn
End Function
' --- Returns the Error Description ---
Function GetErrorDescription ( sName )
Dim sReturn
sReturn = ""
if nErrors > 0 then
for ib = 1 to nErrors
if ErrorField(ib) = sName then sReturn = ErrorMessage(ib)
next
end if
GetErrorDescription = sReturn
End Function
' --- Put Error into Error Management ---
Sub PutError ( errField, errNumber, errMessage )
nErrors = nErrors + 1
Redim Preserve ErrorField(nErrors)
ErrorField(nErrors) = errField
Redim Preserve ErrorNumber(nErrors)
ErrorNumber(nErrors) = errNumber
Redim Preserve ErrorMessage(nErrors)
ErrorMessage(nErrors) = errMessage
Err.Number = 0
End Sub
' --- Put form values into record set ---
Sub UpdateRecordSet ( byref rsUpdt )
' own error handling
On Error Resume Next
for each Feld in Request.Form
' is this a data containing field ?
if (Left(feld, Len(sFormPre)) <> sFormPre) and (Right(feld, Len(sFormPost)) <> sFormPost) then
if Request.Form(feld) = "" then
' put NULL
rsUpdt(feld) = Null
else
' put new value
rsUpdt(feld) = Request.Form(feld)
end if
if (Err.Number <> 0) and (Err.Number <> 438) and (Err.Number <> 3265) then
' for some reason the errors 438, 3265 occur sometime but with no obvious reason
PutError feld, Err.Number, Err.Description
end if
end if
next
if nErrors = 0 then
' make update permanent in DB
rsUpdt.Update
if (Err.Number <> 0) and (Err.Number <> 438) and (Err.Number <> 3265) then
' for any reason the error 3265 occurs always ?!?
PutError "", Err.Number, Err.Description
end if
end if
On Error Goto 0
End Sub
' --- Inserts a single field (incl, heading, form element and definitions ---
Sub InsertFieldForm ( feld , bPrimaryKey )
if bPrimaryKey then
s1 = "<b><i>"
s2 = "</i></b>"
else
s1 = "<b>"
s2 = "</b>"
end if
Response.Write("<tr>")
Response.Write("<TD bgcolor=""#FDE7A2"" VALIGN=TOP><font size=2>" & s1 & feld.name & s2 & _
"</font></TD>")
if IsErrorField (feld.name) then
sBkColor = "#FF0000"
else
sBKColor = "#EFEFEF"
end if
Response.Write(" <TD bgcolor=""" & sBKColor & """><font size=2>")
if (NotAttrib(feld.Attributes, adFldUpdatable) and NotAttrib(feld.Attributes, adFldUnknownUpdatable)) or _
((NotAttrib(feld.Attributes, adFldUpdatable) and bPrimaryKey)) or _
(nMode = mdDelete) then
if IsExcluded(Feld.type) then
Response.Write("<img src=""" & sImageDir & "exclude.gif"" border=""0"" " & _
"alt=""none-editable data"">")
else
Response.Write(feld.value)
end if
else
if bFormSubmit then
sValue = CStr(Request.Form(feld.name))
else
if IsNull(feld.value) then
sValue = ""
else
select case feld.type
case adBoolean
if feld.value then
sValue = "True"
else
sValue = "False"
end if
case else
sValue = CStr(feld.value)
end select
end if
end if
sValue = Server.HTMLEncode(sValue)
select case feld.type
' VARCHAR
case adBSTR, adVariant, adChar, adVarChar, adWChar, adVarWChar
nMaxLength = feld.DefinedSize
if nMaxLength > nMaxInputLength then
nSize = nMaxInputLength
else
nSize = nMaxLength
end if
' MEMO
case adLongVarChar, adLongVarWChar
' ELSE
case else
nMaxLength = feld.Precision
if nMaxLength > nMaxInputLength then
nSize = nMaxInputLength
else
nSize = nMaxLength
end if
end select
if IsExcluded(Feld.type) then
Response.Write("<img src=""" & sImageDir & "exclude.gif"" border=""0"" " & _
"alt=""none-editable data"">")
else
if (feld.type = adLongVarChar) or (feld.type = adLongVarWChar) then
' MEMO -> TEXTAREA
Response.Write("<TEXTAREA NAME=""" & feld.name & """ COLS=" & CStr(nMemoCols) & _
" ROWS=" & CStr(nMemoRows) & ">" & sValue & "</TEXTAREA>")
else
' -> INPUT
Response.Write("<INPUT TYPE=""TEXT"" NAME=""" & feld.name & """ MAXLENGTH=" & _
CStr(nMaxLength) & " SIZE=" & CStr(nSize) & " VALUE=""" & sValue & """>")
end if
' put error message into form
if IsErrorField(feld.name) then
Response.Write("<br><font color=""#FFFFFF""><b>" & GetErrorDescription(feld.name) & _
"</b></font>")
end if
end if
end if
Response.Write(" </font></TD>")
if bViewDefinitions then
Response.Write("<TD valign=top bgcolor=""#EFEFEF""><font size=1>" & _
GetTypeString(feld.type) & "</font></TD>")
Response.Write("<TD valign=top bgcolor=""#EFEFEF""><font size=1>" & _
GetAttributesString(feld.attributes) & "</font></TD>")
end if
Response.Write("</tr>")
End Sub
%>
<% WriteHTMLHeader (UCase(sTitle) & " - " & sSubTitle) %>
<H1><%= sTitle%></H1>
<H3><%= sSubTitle%></H3>
<%
if IsErrorField("") then
Response.Write("<font color=""#FF0000""><b>Update Error:</b></font> ")
Response.Write("(" & GetErrorNumber ("") & ") " &GetErrorDescription("") & "<br><br>")
end if
%>
<FORM METHOD="POST" ACTION="<%=sEditASP%>">
<INPUT TYPE="HIDDEN" NAME="<%=sFormPre%>submit<%=sFormPost%>" VALUE="yes">
<table cellspacing=2 cellpadding=5>
<%
' insert all primary keys
if PrimaryKeyFieldsCount > 0 then
for i = 1 to PrimaryKeyFieldsCount
InsertFieldForm rsForm.fields(PrimaryKeyFields(i)), True
next
end if
' insert all other fields
if StandardFieldsCount > 0 then
for i = 1 to StandardFieldsCount
InsertFieldForm rsForm.fields(StandardFields(i)), False
next
end if
%>
<%
if bViewDefinitions then
nColCount = 4
else
nColCount = 2
end if
%>
<tr bgcolor="#A2A2A2">
<td colspan="<%=nColCount%>" align="center">
<font size=2>
<INPUT TYPE="SUBMIT" CLASS="btnOk" VALUE="<%=sFormOkButton%>" NAME="<%=sFormPre%>ok<%=sFormPost%>"
STYLE="width: 8em">
<INPUT TYPE="SUBMIT" CLASS="btnCancel" VALUE="<%=sFormCancelButton%>" NAME ="<%=sFormPre%>cancel<%=sFormPost%>"
STYLE="width: 8em">
</font>
</td>
</tr>
<tr>
<td valign=middle align=right colspan="<%=nColCount%>">
<font size="1"><a href="<%=sUTELink%>"><%=sUTELongName%></a> v<%=sUTEVersion%></font>
</td></tr>
</table>
<BR>
<table>
<% if bViewDefinitions then %>
<td><a
href="<%=sEditASP%>?<%=sParamMode%>=<%=nMode%>&<%=sParamRecord%>=<%=nRecord%>&<%=sParamDefs%>=no">
<img src="<%=sImageDir%>definition.gif" border="0"></a></td>
<td><font size=1>Hide Field Definitions</font></td>
<% else %>
<td><a
href="<%=sEditASP%>?<%=sParamMode%>=<%=nMode%>&<%=sParamRecord%>=<%=nRecord%>&<%=sParamDefs%>=yes">
<img src="<%=sImageDir%>definition.gif" border="0"></a></td>
<td><font size=1>Show Field Definitions</font></td>
<% end if %>
</tr></table>
</FORM>
<% WriteHTMLFooter %>
Submit an article or tip