File: D:/web/secure/csl/bam/admin/editutils.asp
<%
Sub GetEditSettings(AForView)
Dim i
' get main edit details
OpenQuery("SELECT * FROM Edits WHERE EditID='" + gsEditID + "'")
If Not EndOfQuery Then
gsTableName = GetQueryValue("TableName")
gsKeyField = GetQueryValue("KeyField")
gbShowAll = GetQueryValue("ShowAll")
gbAllowView = GetQueryValue("AllowView")
gbAllowEdit = GetQueryValue("AllowEdit")
gbAllowAdd = GetQueryValue("AllowAdd")
gbAllowDelete = GetQueryValue("AllowDelete")
gnAccessView = GetQueryValue("AccessView")
gnAccessEdit = GetQueryValue("AccessEdit")
gnAccessAdd = GetQueryValue("AccessAdd")
gnAccessDelete = GetQueryValue("AccessDelete")
gsViewOrderBy = GetQueryValue("ViewOrderBy") & "" ' (SS,7/5/03)
gsViewTable = GetQueryValue("ViewTable") & "" ' (SS,9/5/03)
Else
gsError = "Could not find EditID " + gsEditID
End If
CloseQuery
If gsError = "" Then
If AForView = True Then
' get details of view
OpenQuery("SELECT * FROM EditView WHERE EditID='" + gsEditID + "' ORDER BY OrderNo")
i = 0
Do While Not EndOfQuery
i = i + 1
gasFieldName(i) = GetQueryValue("FieldName")
gasPromptName(i) = GetQueryValue("PromptName")
If IsNull(gasPromptName(i)) Or gasPromptName(i) = "" Then gasPromptName(i) = gasFieldName(i)
gasFieldType(i) = GetQueryValue("FieldType")
ganWidth(i) = GetQueryValue("Width")
gabLink(i) = GetQueryValue("Link")
NextQueryRecord
Loop
gnColumns = i
CloseQuery
Else
' get details of edit
OpenQuery("SELECT * FROM EditDetail WHERE EditID='" + gsEditID + "' ORDER BY OrderNo")
i = 0
Do While Not EndOfQuery
i = i + 1
gasFieldName(i) = GetQueryValue("FieldName")
gasPromptName(i) = GetQueryValue("PromptName")
If IsNull(gasPromptName(i)) Or gasPromptName(i) = "" Then gasPromptName(i) = gasFieldName(i)
gasFieldType(i) = GetQueryValue("FieldType")
gasEditType(i) = GetQueryValue("EditType")
gasReadOnly(i) = GetQueryValue("ReadOnly")
gasLookupID(i) = GetQueryValue("LookupID")
ganWidth(i) = GetQueryValue("Width")
If IsNull(ganWidth(i)) Or ganWidth(i) = 0 Then ganWidth(i) = 15
ganHeight(i) = GetQueryValue("Height")
gabRequired(i) = GetQueryValue("Required")
gasValidation(i) = GetQueryValue("Validation")
gasPicture(i) = GetQueryValue("Picture")
NextQueryRecord
Loop
gnColumns = i
CloseQuery
' get lookup details
OpenQuery("SELECT * FROM Lookups")
For i = 1 To gnColumns
If gasLookupID(i) <> "" And FindRecord("LookupID", gasLookupID(i)) Then
gasLKFieldName(i) = GetQueryValue("FieldName")
gasLKDisplayFieldName(i) = NB(GetQueryValue("DisplayFieldName")) ' (SS,6/12/14)
gasLKTableName(i) = GetQueryValue("TableName")
gabLKAllowBlank(i) = GetQueryValue("AllowBlank")
Else
gasLKFieldName(i) = ""
gasLKTableName(i) = ""
End If
Next
CloseQuery
End If
End If
End Sub
Sub ShowTableView
' *** need to sort out the style sheets
Const MAX_RECS_TO_SHOW = 100
Dim i, bRow1, LValue, LSQL, LRecordCount, LTotalRecords
' show the added button
Response.Write("<FORM name=""TableView"" action=""edit.asp?id=" + gsEditID + """ method=""post"">")
Response.Write("<input type=""hidden"" name=""uFormName"" value=""TableView"">" + vbCrLf)
' *** debug code
' (SS,29/11/14) changed gbDebugMode to gbDebugOn
If gbDebugOn Then
Response.Write("ID***" + gsShowRecordsID + "***<BR>")
Response.Write("gsEDITID***" + gsEditID + "***<BR>")
End If
' set defaults for ShowRecord values if new or different table
If gsShowRecordsID = "" Or gsShowRecordsID <> gsEditID Then
Session("ShowRecordsID") = gsEditID ' preserve the previous For
gsShowRecordsID = gsEditID
gsShowRecordsField = ""
gsShowRecordsStart = ""
gsShowRecordsEnd = ""
Else ' else save in session variables
Session("ShowRecordsID") = gsShowRecordsID
Session("ShowRecordsField") = gsShowRecordsField
Session("ShowRecordsStart") = gsShowRecordsStart
Session("ShowRecordsEnd") = gsShowRecordsEnd
End If
If Not gbShowAll Then
' show combo for fields
Response.Write("Field: <select name=""ShowRecordsField"">" + vbCrLf)
For i = 1 To gnColumns
Response.Write(GetSelectedOption(gasFieldName(i), gsShowRecordsField, ""))
Next
Response.Write("</select>" + vbCrLf)
Response.Write("Start: <input type=""text"" name=""ShowRecordsStart"" size=""10"" value=""" + gsShowRecordsStart + """>")
Response.Write(" End: <input type=""text"" name=""ShowRecordsEnd"" size=""10"" value=""" + gsShowRecordsEnd + """>")
Response.Write(" <input type=""submit"" name=""uButton"" value=""Search"">" + vbCrLf)
Response.Write("<BR>")
gsFocusForm = "TableView"
gsFocusField = "ShowRecordsField"
End If
' only show add button if allowed to edit
If gnAccessLevel >= gnAccessEdit Then
Response.Write("<BR><input type=""submit"" name=""uButton"" value=""Add"">" + vbCrLf)
End If
Response.Write("</FORM>")
'ADO Message to go here
' do the search if Search button pressed or previous form was "EditForm" or Show All
If gbShowAll Or gsButton = "Search" Or gsFormName = "EditForm" Then
If gbShowAll Then
' (SS,9/5/03) added gsViewTable
Dim LViewTable
If gsViewTable = "" Then
LViewTable = gsTableName
Else
LViewTable = gsViewTable
End If
' (SS,7/5/03) added gsViewOrderBy
If gsViewOrderBy = "" Then
LSQL = "SELECT * FROM " + LViewTable + " ORDER BY " + gsKeyField
Else
LSQL = "SELECT * FROM " + LViewTable + " ORDER BY " + gsViewOrderBy
End If
Else
' *** debug code
If gbDebugMode Then
Response.Write("ID***" + gsShowRecordsID + "***<BR>")
Response.Write("Field***" + gsShowRecordsField + "***<BR>")
Response.Write("Start***" + gsShowRecordsStart + "***<BR>")
Response.Write("End***" + gsShowRecordsEnd + "***<BR>")
End If
If gsShowRecordsField = "" Then
LSQL = "SELECT * FROM " + gsTableName + " ORDER BY " + gsKeyField
Else
LSQL = "SELECT * FROM " + gsTableName + " WHERE " + GetStartEndWhere(gsShowRecordsField, gsShowRecordsStart, gsShowRecordsEnd) + " ORDER BY " + gsKeyField
End If
End If
' *** debug code
' (SS,29/11/14) changed gbDebugMode to gbDebugOn
If gbDebugOn Then
Response.Write(LSQL)
End If
OpenQuery(LSQL)
' count records
LRecordCount = 0
Do While Not EndOfQuery
LRecordCount = LRecordCount + 1
NextQueryRecord
Loop
LTotalRecords = LRecordCount
If LTotalRecords = 0 Then
Response.Write("<Strong>No records found.</Strong>")
Else
If gbShowAll Then
Response.Write("<Strong>There are " & LTotalRecords & " records in this table.</Strong>")
Else
Response.Write("<Strong>There are " & LTotalRecords & " records matching the search.</Strong>")
End If
End If
If LTotalRecords > MAX_RECS_TO_SHOW And Not gbShowAll Then
Response.Write("<BR><Strong>Only the first " & MAX_RECS_TO_SHOW & " are shown below.</Strong>")
End If
Response.Write("<BR><BR>")
' display the records if they are any
If LTotalRecords > 0 Then
' show headings
Response.Write("<TABLE cellspacing=0 cellpadding=2 border=1><TR class=row2>")
For i = 1 To gnColumns
Response.Write("<TH ALIGN=LEFT><strong>" + gasPromptName(i) + "</strong></TH>" + vbCrLf)
Next
Response.Write("</TR>")
' show records
LRecordCount = 0
FirstQueryRecord
bRow1 = True
Do While Not EndOfQuery
If (LRecordCount >= MAX_RECS_TO_SHOW) And Not gbShowAll Then
Exit Do
End If
Response.Write("<TR class=")
If bRow1 Then Response.Write("row1") Else Response.Write("row2")
bRow1 = not bRow1
Response.Write(">")
Dim LAlign ' (SS,9/5/03)
For i = 1 To gnColumns
LValue = GetQueryValue(gasFieldName(i))
If IsNull(LValue) Or LValue & "" = "" Then LValue = " " ' show non blank space if value is blank
If gasFieldType(i) = "N" Then LAlign = " ALIGN=""RIGHT""" Else LAlign = ""
If gabLink(i) Then
Response.Write("<TD" & LAlign & "><a href=edit.asp?id=" + gsEditID + "&key=" & Server.URLEncode(GetQueryValue(gsKeyField)) + ">" & LValue & "</a></TD>")
Else
Response.Write("<TD" & LAlign & ">" & LValue & "</TD>")
End If
Next
Response.Write("</TR>" + vbCrLf)
LRecordCount = LRecordCount + 1
' (SS,28/10/16)
If FunctionExists("CustomShowTableViewCurrentRecordHook") Then
CustomShowTableViewCurrentRecordHook LViewTable
End If
NextQueryRecord
' (SS,28/10/16)
If FunctionExists("CustomShowTableViewNextRecordHook") Then
CustomShowTableViewNextRecordHook LViewTable
End If
Loop
End If
Response.Write("</TABLE>")
CloseQuery
End If
End Sub
Sub ShowEditForm(AIsNew)
Dim i, LLKValue, LValue, LValidation, LLKDisplayValue, LSelected ' (SS,6/12/14) added LKDisplayValue and LSelected
Response.Write("<FORM name=""frmEdit"" action=""edit.asp?id=" + gsEditID + """ method=""post"">")
Response.Write("<input type=""hidden"" name=""uFormName"" value=""EditForm"">" + vbCrLf)
Response.Write("<input type=""hidden"" name=""uIsNewRecord"" value=""" & AIsNew & """>" + vbCrLf)
Response.Write("<TABLE border=0 cellpadding=0 cellspacing=0>")
' if new record then set value to blank, else get values from current record
If AIsNew = True And Not gbEditRetry Then
For i = 1 To gnColumns
gasFieldValue(i) = ""
Next
Else
' *** need to sort out where key can be a string or number
' OpenQuery("SELECT * FROM " + gsTableName + " WHERE " + gsKeyField + "=" + sKey)
' (SS,6/5/03) added code to handle numeric key (need to develop it further)
' (SS,7/12/14) improved to handle date in MySQL (type "D")
If gasFieldType(1) = "D" Then
OpenQuery("SELECT * FROM " + gsTableName + " WHERE " + gsKeyField + "=""" + ConvertUKToMySQLDate(gsKey) + """") ' (SS,7/12/14) for dates
ElseIf gasFieldType(1) <> "N" Then
OpenQuery("SELECT * FROM " + gsTableName + " WHERE " + gsKeyField + "=""" + gsKey + """")
Else
OpenQuery("SELECT * FROM " + gsTableName + " WHERE " + gsKeyField + "=" + gsKey)
End If
If Not EndOfQuery Then
For i = 1 To gnColumns
gasFieldValue(i) = GetQueryValue(gasFieldName(i))
' if null then set to blank
If IsNull(gasFieldValue(i)) Then gasFieldValue(i) = ""
Next
End If
CloseQuery
End If
gsFocusForm = "frmEdit"
gsFocusField = gasFieldName(1)
' set gsFocusField to first Readonly field, or first field if new
'If AIsNew Then
' gsFocusField = gasFieldName(1)
'Else
' (SS,7/5/03) removed above so it works for autoinc fields which aren't focused
For i = 1 to gnColumns
If Not gasReadOnly(i) Then
gsFocusField = gasFieldName(i)
Exit For
End If
Next
'End If
' show fields as text boxes, combo boxes etc.
For i = 1 To gnColumns
Response.Write("<TR>")
Response.Write("<TD NOWRAP HEIGHT=22>" + gasPromptName(i) + ": </TD>")
Response.Write("<TD>" + vbCrLf)
If IsNull(gasLookupID(i)) Or gasLookupID(i) = "" Then
' define input text box
' if date then convert to UK date format else use as it is
If gasFieldType(i) = "D" Then
LValue = GetUKDate(gasFieldValue(i))
Else
' Used Server.HTMLEncode in following otherwise things like quotes will not work correctly
LValue = Server.HTMLEncode(gasFieldValue(i))
End If
' if new record or not readonly, or not allowed to edit then show text box, else display as label
' If AIsNew Or Not gasReadOnly(i) And (gnAccessLevel >= gnAccessEdit) Then
' (SS,7/5/03) replaced above with following, field is readonly even if adding new (in case autoinc)
If Not gasReadOnly(i) And (gnAccessLevel >= gnAccessEdit) Then
If gasFieldType(i) = "N" Then
LValidation = " onblur=""uValidateNumber('frmEdit', '" + gasFieldName(i) + "')"""
ElseIf gasFieldType(i) = "D" Then
LValidation = " onblur=""convert_date(" + gasFieldName(i) +")"""
gbIncludeDateValidation = True ' so that date validation javascript code is included
Else
LValidation = ""
End If
If ganHeight(i) > 1 Then
Response.Write("<textarea type=""text"" name=""" + gasFieldName(i) + """ cols=" & ganWidth(i) & LValidation + " rows=""" & ganHeight(i) & """>" & LValue & "</textarea>")
Else
Response.Write("<input type=""text"" name=""" + gasFieldName(i) + """ size=" & ganWidth(i) & LValidation + " value=""" & LValue & """>")
End If
Else
Response.Write("<font face=""Arial"" size=""2""><b>")
Response.Write(LValue)
Response.Write("</b></font>")
End If
Response.Write("</TD>")
Else
If AIsNew Or Not gasReadOnly(i) And (gnAccessLevel >= gnAccessEdit) Then
Response.Write("<select name=""" + gasFieldName(i) + """>" + vbCrLf)
If gabLKAllowBlank(i) Then Response.Write("<option></option>" + vbCrLf)
' OpenQuery("SELECT * FROM " + gasLKTableName(i))
' (SS,30/4/15) replaced above with following, i.e. added ORDER BY field name, dates where appearing in entered order, instead of date order
OpenQuery("SELECT * FROM " + gasLKTableName(i) + " ORDER BY " + gasLKFieldName(i))
Do While Not EndOfQuery
LLKValue = GetQueryValue(gasLKFieldName(i))
' (SS,6/12/14) if no separate display field then use the main field, else use the display field
If gasLKDisplayFieldName(i) = "" Then
LLKDisplayValue = LLKValue
Else
LLKDisplayValue = NB(GetQueryValue(gasLKDisplayFieldName(i)))
End If
' show current value as selected in the combo box
' (SS,7/5/03) added & "" to fix problem when dates being used
' (SS,6/12/14) added CStr to insure match in MySQL due to possible different types
If CStr(gasFieldValue(i)) & "" = CStr(LLKValue) Then
LSelected = " selected"
Else
LSelected = ""
End If
' (SS,6/12/14) added value LLKValue to allow different value to be displayed to the one assigned
Response.Write("<option" & LSelected & " value=""" & LLKValue & """>")
' (SS,5/12/14) replaced + with &, and (6/12/14) LLKValue with LLKDisplayValue
Response.Write(LLKDisplayValue & "</option>" & vbCrLf)
NextQueryRecord
Loop
Response.Write("</select>" + vbCrLf)
CloseQuery
Else
Response.Write("<font face=""Arial"" size=""2""><b>")
Response.Write(gasFieldValue(i))
Response.Write("</b></font>")
End If
End If
Response.Write("</TR>" + vbCrLf)
Next
Response.Write("</TABLE>")
' show save, cancel and delete buttons
Response.Write("<br>" + vbCrLf)
' only save button if edit allowed
If gnAccessLevel >= gnAccessEdit Then
Response.Write("<input type=""submit"" name=""uButton"" value=""Save"">" + vbCrLf)
End If
Response.Write("<input type=""submit"" name=""uButton"" value=""Cancel"">" + vbCrLf)
' only show Delete button if record isn't new and deletion allowed
If AIsNew = False And gnAccessLevel >= gnAccessDelete Then
Response.Write("<input type=""submit"" name=""uButton"" value=""Delete"">" + vbCrLf)
End If
' add hidden key field, which is used to determine which record to post changes to
Response.Write("<input type=""hidden"" name=""uKeyField1"" value=""" + gsKey + """>" + vbCrLf)
Response.Write("</FORM>")
End Sub
Sub SaveRecord
Dim i, LKeyFieldValue, LAbort, LValue, LNewRecord
Dim n, LTemp, LChar ' (SS,7/12/14)
' if allowed to make changes then allow
If gnAccessLevel >= gnAccessEdit Then
LAbort = False
LNewRecord = False
OpenTable(gsTableName)
' get key field from form
LKeyFieldValue = Request.Form("uKeyField1")
' adding new record then add new (i.e. if original key is blank)
If LKeyFieldValue = "" Then
AddRecord
LNewRecord = True
Else
' if key exists then overwrite existing one else show error
'*** need to change following to handle numbers as well
'If FindFirstRecord("GraveNo=" + strGraveNo) then
Dim LFindFirstCriteria ' (SS,6/5/03)
' (SS,6/5/03) added code to handle numeric key (need to develop it further)
If gasFieldType(1) <> "N" Then
LFindFirstCriteria = gsKeyField + "=" + "'" + LKeyFieldValue + "'"
Else
LFindFirstCriteria = gsKeyField + "=" + LKeyFieldValue
End If
If FindFirstRecord(LFindFirstCriteria) then
EditRecord
Else
'*** to show error that record to edit couldn't be found
LAbort = True
End If
End If
If Not LAbort Then
' for each field
For i = 1 To gnColumns
LValue = Request.Form(gasFieldName(i))
' if date field then convert to US format to place correctly
If gasFieldType(i) = "D" Then
' LValue = ConvertUKToUSDate(LValue) ' *** (SS,9/1/02) may need to fix date problem using CDate and avoiding ConvertUKToUSDate
LValue = Trim(LValue) ' (SS,20/10/15) replaced above with this to fix issue where dates were being saved in American format
ElseIf gasFieldType(i) = "S" Then ' if string the trim off the right spaces
LValue = RTrim(LValue)
If gasPicture(i) = "*!" Then
LValue = UCase(LValue)
' (SS,7/12/14) only allow upper case letters, strip the rest
ElseIf gasPicture(i) = "*&" Then
LValue = UCase(LValue)
LTemp = ""
For n = 1 To Len(LValue)
LChar = Mid(LValue, n, 1)
If IsCharAlpha(LChar) Then
LTemp = LTemp + LChar
End If
Next
LValue = LTemp
End If
End If
' put the value in array in case there's an error in which current values will be used as defaults next time
gasFieldValue(i) = LValue
' only place if record is new or field is not read only
'If LNewRecord Or Not gasReadOnly(i) Then
' (SS,7/5/03) replaced above with below
If Not gasReadOnly(i) Then
PutFieldValue gasFieldName(i), LValue
End If
Next
PostRecord
End If
CloseTable
Else
gsErrorMessage = "You do not have permission to make changes here."
End If
End Sub
Sub DeleteRecord
Dim LKeyFieldValue
' if allowed to make changes then allow
If gnAccessLevel >= gnAccessDelete Then
LKeyFieldValue = Request.Form("uKeyField1")
If LKeyFieldValue <> "" Then
'*** need to change following to handle numbers as well (see SaveRecord)
' (SS,8/12/14) referential check to prevent deletion if key used by a table, calls a custom routine if it exists
If FunctionExists("RelatedRecordsCheck") Then
' if related record exists then gsErrorMessage is set to a message which is displayed, and routine exits with deleted record
If RelatedRecordsCheck(gsTableName, gsKeyField, LKeyFieldValue, gsErrorMessage) Then
Exit Sub
End If
End If
' (SS,6/5/03) added code to handle numeric key (need to develop it further)
Dim LSQL
' (SS,7/12/14) improved to handle date in MySQL (type "D")
If gasFieldType(1) = "D" Then
LSQL = "DELETE FROM " + gsTableName + " WHERE " + gsKeyField + "=" + "'" + ConvertUKToMySQLDate(LKeyFieldValue) + "'" ' (SS,7/12/14) for dates
ElseIf gasFieldType(1) <> "N" Then
LSQL = "DELETE FROM " + gsTableName + " WHERE " + gsKeyField + "=" + "'" + LKeyFieldValue + "'"
Else
LSQL = "DELETE FROM " + gsTableName + " WHERE " + gsKeyField + "=" + LKeyFieldValue
End If
ExecuteQuery(LSQL)
End If
Else
gsErrorMessage = "You do not have permission to delete records here."
End If
End Sub
Function GetSelectedOption(AActualValue, ASelectedValue, AReturnValue)
Dim LValueEquals
If AReturnValue <> "" Then
LValueEquals = " value=""" + AReturnValue + """"
Else
LValueEquals = ""
End If
If AActualValue = ASelectedValue Then
GetSelectedOption = "<option selected" + LValueEquals + ">" + AActualValue + "</option>" + vbCrLf
Else
GetSelectedOption = "<option" + LValueEquals + ">" + AActualValue + "</option>" + vbCrLf
End If
End Function
' (SS,10/10/01) following used by queries to create the WHERE clause
Function GetStartEndWhere(AFieldName, AStartValue, AEndValue)
Dim LWhere, i, LFieldType, LQuote
LWhere = ""
LFieldType = ""
' find the field type
For i = 1 To gnColumns
If gasFieldName(i) = AFieldName Then
LFieldType = gasFieldType(i)
Exit For
End If
Next
'*** need to show error that field type not found if LFieldType = ""
If LFieldType = "S" Then
LQuote = "'"
Else
LQuote = ""
End If
' if end value is blank then assume "=" instead of ">=" and "<="
If AEndValue = "" Then
LWhere = AFieldName + "=" + LQuote + AStartValue + LQuote
Else
LWhere = AFieldName + ">=" + LQuote + AStartValue + LQuote + " AND " + AFieldName + "<=" + LQuote + AEndValue + LQuote
End If
GetStartEndWhere = LWhere
End Function
' (SS,12/10/01) converts given date to UK string format, assumes regional setting on PC is UK
Function GetUKDate(ADate)
If IsNull(ADate) or ADate = "" Then
GetUKDate = ""
Else
' GetUKDate = DatePart("d", ADate) & "/" & DatePart("m", ADate) & "/" & DatePart("yyyy", ADate)
GetUKDate = FormatDateTime(ADate, VbShortDate)
End If
End Function
' (SS,12/10/01) converts given UK date in string to US date, assumes regional setting on PC is UK
Function ConvertUKToUSDate(ADate)
If IsNull(ADate) or ADate = "" Then
ConvertUKToUSDate = Null ' because blank date can only be saved as Null not empty string
Else
ConvertUKToUSDate = DatePart("m", ADate) & "/" & DatePart("d", ADate) & "/" & DatePart("yyyy", ADate)
End If
End Function
%>