|
Server : Apache/2.4.62 System : FreeBSD fbsdweb2.web.rcn.net 14.1-RELEASE FreeBSD 14.1-RELEASE releng/14.1-n267679-10e31f0946d8 GENERIC amd64 User : www ( 80) PHP Version : 8.3.8 Disable Function : NONE Directory : /domains/mguerinweb/Offline_Archive/DBAdmin/ |
Upload File : |
<%
'ocdForm.asp - 1 Click DB SQL to ASP Form Object
'copyright 1997-2002 David J. Kawliche, AccessHelp.net
'1 Click DB technology is fully protected by international
'laws and treaties. Never use, distribute, or redistribute
'any software and/or source code in violation of its licensing.
'Use of this software and/or source code is strictly at your own risk.
'All warranties are specifically disclaimed except as required by law.
'IMPORTANT : THIS IS NOT AN APPLICATION SECURITY PRODUCT !
'
'To enforce application security, set appropriate logins
'and permissions for all web server and database users.
'
'Use object and configuration properties _only_ to customize
'application appearance and interactions with other components.
'For more information see : http://1ClickDB.com
Class ocdForm
Public ADOConnection 'ADO connection currently in use for the object
Public ADORecordset 'ADO recordset containing either the record being edited or the empty structure of the recordset being added to
Public SQLConnect 'ADO connection string
Public SQLUser 'ADO connection user name
Public SQLPass 'ADO connection password
Public SQLSelect 'Comma delimited list of fields to be displayed for edit
Public SQLFrom 'Name of table to be edited, using an SQL Join is possible but may sometimes produce unpredictable results, test first
Public SQLWhereExtra 'Use to set extra security restrictions
Public SQLWhere 'When no autoincrement field is present, used to identify record
Public AllowEdit 'if true, enable editing existing records
Public AllowAdd 'if true, enable adding new records
Public AllowView 'if true, enable viewing of records
Public AllowDelete 'if true, enable deletion of records
Public AllowMultiDelete
Public DatabaseType 'Determined automatically in code, should generally be used as a read only field
Public HTMLCheckField 'HTML string containing the text displayed by a field that needs checking, default is red letter saying "Check Field"
Public HTMLAttribSaveBtn 'TAG Attributes, include INPUT TYPE and VALUE for Save Button
Public HTMLAttribCancelBtn 'TAG Attributes, include INPUT TYPE and VALUE for Cancel Button
Public HTMLAttribNewBtn 'TAG Attributes, include INPUT TYPE and VALUE for New Button
Public HTMLAttribDeleteBtn 'TAG Attributes, include INPUT TYPE and VALUE for Delete Button
Public HTMLStatusFieldError 'HTML displayed in error message when field cannot be updated
Public HTMLNotFound 'HTML displayed in error message when record cannot be found
Public HTMLOLEError 'HTML in place of ADO message "Multiple-step operation generated errors" for generic -2147217887 msg
Public HTMLUpdateFieldFails
Public HTMLAutoIncrement 'HTML displayed for autoincrement field value when adding a new record
Public HTMLStatusStart 'HTML placed before error message display (if any)
Public HTMLStatusEnd 'HTML placed before error message display (if any)
Public FormStatus 'a string containing any form error messages
Public HTMLAttribForm
Public EnablePrimaryKeyLink
Public FormMode
Public EditMode
Public SQLID
Public FormEStringToken
Public FormNullToken
Public InvalidFields
Public CallBeforeDelete
Public CallAfterDelete
Public CallBeforeUpdate
Public CallAfterUpdate
Public CallBeforeInsert
Public CallAfterInsert
Public CallOnCancel
Public CallPreDelete
Public MayBeReplica
'**Start Encode**
'internal reserved
Public QuoteSuffix
Public QUotePrefix
Private SQLSelectPK
Public SQLSelectID
Private FormEditConnect
Private ADOMode 'can be used to set connection lock types
Public Debug
Private sub Class_Initialize
%><!--#INCLUDE FILE=ocdForm_Lang.asp--><%
MayBeReplica = True
Debug = False
FormNullToken = ""
FormEditConnect = True
SQLID = ""
FormEStringToken = """"""
AllowMultiDelete = False
DatabaseType = ""
SQLSelectID = ""
SQLSelectPK = ""
SQLWhereExtra = ""
SQLWHERE = ""
EnablePrimaryKeyLink = True
CallBeforeDelete = True
CallAfterDelete = True
CallBeforeUpdate = True
CallAfterUpdate = True
CallBeforeInsert = True
CallAfterInsert = True
CallOnCancel = False
CallPreDelete = False
QuoteSuffix =""""
QuotePrefix =""""
ADOMode = 3 'adOpenReadWrite 0 'adOpenUnknown
End sub
Public sub DisplayFieldAsTextBox (strFieldName, strDefault, strAttributes)
on error resume next
dim tcf '- temp for CreateField return value
tcf= ""
Select Case EditMode
Case "Add", "Edit"
If strFIeldName = "s_Generation" and MayBeReplica Then
if EditMode = "Edit" Then
tcf = ADORecordset.Fields(strFieldName).Value
End if
Elseif left(strFIeldName,4) = "Gen_" and MayBeReplica Then
if EditMode = "Edit" Then
tcf = ADORecordset.Fields(strFieldName).Value
End if
ElseIf ADORecordset.FIelds(strFieldName).Type = 72 Then
if EditMode = "Edit" Then
tcf = ADORecordset.Fields(strFieldName).Value
End if
ElseIf UCase(strFieldName) = UCASE(SQLSelectID) Then
If EditMode = "Edit" Then
tcf = ADORecordset.Fields(strFieldName).Value & vbCRLF
Else
tcf = HTMLAutoIncrement
End if
Else
tcf = tcf & "<INPUT "
tcf = tcf & "TYPE=""text"" "
tcf = tcf & "NAME=""ocdTF" & Server.HTMLEncode(strFieldName) & """ "
tcf = tcf & "VALUE="""
if FormMode = "Save" Then
tcf= tcf & server.htmlencode(Request.Form("ocdTF" & strFieldName))
Else
if EditMode = "Add" Then
tcf= tcf & server.htmlencode(strDefault)
Else
if not isnull(ADORecordset.Fields(strFieldName).Value) then
Select Case ADORecordset.Fields(strFieldName).Type
Case 6
tcf= tcf & server.htmlencode(FormatCurrency(ADORecordset.Fields(strFieldName).Value))
Case 202, 203, 200,201
if ADORecordset.Fields(strFieldName).Value = "" Then
tcf= tcf & server.htmlencode(FormEStringToken)
Else
tcf= tcf & server.htmlencode(ADORecordset.Fields(strFieldName).Value)
End if
Case Else
tcf= tcf & server.htmlencode(ADORecordset.Fields(strFieldName).Value)
End Select
end if
End if
End if
tcf = tcf & """ "
tcf = tcf & strAttributes
tcf = tcf & ">"
If FormMode = "Save" Then
if IsFieldDataInvalid(strFieldName) Then
tCF = tCF & HTMLCheckField
End if
End if
End if
Case "ReadOnly"
if not isnull(ADORecordset.Fields(strFieldName).Value) then
if ADORecordset.Fields(strFieldName).Type = 6 Then
tcf= tcf & server.htmlencode(FormatCurrency(ADORecordset.Fields(strFieldName).Value))
Else
tcf= tcf & server.htmlencode(ADORecordset.Fields(strFieldName).Value)
End if
end if
Case Else
tCF = ""
End Select
' response.write err.number
Response.write tcf
end sub
public sub DisplayFieldAsCheckBox(strFieldName, varCheckValue, varUncheckValue, varDefault, strAttributes)
dim tcf
tcf = ""
Select Case EditMode
Case "Add", "Edit"
tcf = "<INPUT TYPE=""Checkbox"" Name=""ocdCB" & Server.HTMLENcode(strFieldName) & """ "
if FormMode = "Save" Then
if request.form("ocdCB" & strFieldName) <> "" Then
tcf= tcf & "CHECKED"
End if
ElseIf EditMode = "Edit" Then
if not isnull(ADORecordset.Fields(strFieldName).Value) Then
if Cstr(ADORecordset.Fields(StrFieldName).Value) = Cstr(varCheckValue & "") Then
tcf = tcf & "CHECKED"
End if
end if
Else
if Cstr(varDefault & "") = Cstr(varCheckValue & "") Then
tcf = tcf & "CHECKED"
End if
End if
tcf =tcf & " " & strAttributes & " >"
tcf = tcf & "<INPUT TYPE=""Hidden"" Name=""ocdCT" & Server.HTMLENcode(strFieldName) & """ VALUE=""" & Server.HTMLEncode(CSTR(varCheckValue & "")) & """>"
tcf = tcf & "<INPUT TYPE=""Hidden"" Name=""ndchf" & Server.HTMLENcode(strFieldName) & """ VALUE=""" & Server.HTMLEncode(CSTR(varUnCheckValue & "")) & """>"
If FormMode = "Save" Then
if IsFieldDataInvalid(strFieldName) Then
tCF = tCF & HTMLCheckField
End if
End if
Case "ReadOnly"
if not isnull(ADORecordset.Fields(strFieldName).Value) then
tcf= tcf & server.htmlencode(ADORecordset.Fields(strFieldName).Value)
end if
Case Else
tCF = ""
End Select
Response.write tcf
end sub
public sub DisplayFieldAsMemo(strFieldName, strDefault, strAttributes)
dim tcf '- temp for CreateField return value
dim tvarTemp
Select Case EditMode
Case "Add", "Edit"
tcf = tcf & "<TEXTAREA "
tcf = tcf & "NAME=""ocdTF" & Server.HTMLEncode(strFieldName) & """ "
tcf = tcf & strAttributes & " "
tcf = tcf & ">"
if FormMode = "Save" Then
tcf= tcf & server.htmlencode(Request.Form("ocdTF" & strFieldName))
Else
if EditMode = "Add" Then
tcf= tcf & server.htmlencode(strDefault)
Else
tvarTemp = ADORecordset.Fields(strFieldName).Value
if not isnull(tvarTemp) then
if tvarTemp = "" Then
tcf= tcf & server.htmlencode(FormEStringToken)
Else
tcf= tcf & server.htmlencode(tvarTemp)
end if
end if
End if
End if
tcf = tcf & "</TEXTAREA>"
If FormMode = "Save" Then
if IsFieldDataInvalid(strFieldName) Then
tCF = tCF & HTMLCheckField
End if
End if
Case "ReadOnly"
tvarTemp = ADORecordset.Fields(strFieldName).Value
if not isnull(tvarTemp) then
tcf= tcf & server.htmlencode(tvarTemp)
end if
Case Else
tCF = ""
End Select
Response.write tcf
end sub
public sub DisplayFieldAsSelectList(strFieldName, strBoundValues, strDisplayValues, strDefaultValue, strAttributes)
dim tCDDF '- variable to hold return value of function
dim tarrBound
dim tarrDisplay
dim tintI
dim blnSL
blnSL = False
tcDDF = ""
if AllowEdit Then
tarrBound = split(strBoundValues,";")
tarrDisplay = split(strDisplayValues,";")
tCDDF = tCDDF & "<SELECT "
tCDDF = tCDDF & "NAME=""ocdTF" & Server.HTMLEncode(strFieldName) & """ "
tCDDF = tCDDF & strAttributes & ">"
for tintI = 0 to UBound(tarrBound)
tCDDF = tCDDF & "<OPTION VALUE="""
if tarrBound(tintI) <> "" Then
tCDDF = tCDDF & Server.HTMLEncode(tarrBound(tintI))
End if
tCDDF = tCDDF & """ "
if request.form("ocdTF" & strFieldName) <> "" Then
if Cstr(tarrBound(tintI)) = Cstr(request.form("ocdTF" & strFieldName)) Then
tCDDF = tCDDF & "SELECTED "
blnSL = True
' response.write "XXXXX"
End if
Else
if (SQLID <>"" or SQLWHERE <> "") And FormStatus = "" AND InvalidFields = "" Then
if not ADORecordset.eof Then
Select Case ADORecordset.Fields(strFieldName).Type
Case 11 'adBoolean
if tarrBound(tintI) = "" Then
if isnull(ADORecordset.Fields(strFieldName).Value) Then
tCDDF = tCDDF & "SELECTED "
blnSL = True
End if
Elseif CINT(tarrBound(tintI)) = CInt(ADORecordset.Fields(strFieldName).Value) Then
tCDDF = tCDDF & "SELECTED "
blnSL = True
End if
Case Else
if Cstr(tarrBound(tintI)) = Cstr(ADORecordset.Fields(strFieldName).Value & "") Then
tCDDF = tCDDF & "SELECTED "
blnSL = True
End if
if tarrBound(tintI) = "" and isnull(ADORecordset.Fields(strFieldName).Value) Then
tCDDF = tCDDF & "SELECTED "
blnSL = True
End if
End Select
Else
if tarrBound(tintI) = strDefaultValue Then
tCDDF = tCDDF & "SELECTED "
blnSL = True
end if
End if
Elseif (SQLID = "" and SQLWHERE = "") And FormStatus = "" and InvalidFields = "" Then
if tarrBound(tintI) = strDefaultValue Then
blnSL = True
tCDDF = tCDDF & "SELECTED "
end if
end if
End if
tCDDF = tCDDF & ">"
if strDisplayValues = "" Then
if tarrBound(tintI) <> "" then
tCDDF = tCDDF & Server.HTMLEncode(tarrBound(tintI))
End if
Else
if tarrDisplay(tintI) <> "" then
tCDDF = tCDDF & Server.HTMLEncode(tarrDisplay(tintI))
End if
End if
Response.write tcddF
tcddf = ""
next
if not blnSL Then
tCDDF = tCDDF & "<OPTION VALUE="""
if request.form("ocdTF" & strFieldName) <> "" Then
'response.write "XXXXX"
tCDDF = tCDDF & Server.HTMLEncode(request.form("ocdTF" & strFieldName))
Elseif (SQLID <> "" or SQLWHERE <> "") And FormStatus = "" AND InvalidFields = "" Then
if not isnull(ADORecordset.Fields(strFieldName).Value) Then
tCDDF = tCDDF & Server.HTMLEncode(ADORecordset.Fields(strFieldName).Value)
End if
End if
tCDDF = tCDDF & """ SELECTED>"
if (SQLID <>"" or SQLWHERE <> "") And FormStatus = "" AND InvalidFields = "" Then
if request.form("ocdTF" & strFieldName) <> "" Then
tCDDF = tCDDF & Server.HTMLEncode(request.form("ocdTF" & strFieldName))
Elseif (SQLID <>"" or SQLWHERE <> "") And FormStatus = "" AND InvalidFields = "" Then
if not isnull(ADORecordset.Fields(strFieldName).Value) Then
tCDDF = tCDDF & Server.HTMLEncode(ADORecordset.Fields(strFieldName).Value)
End if
End if
Else
tCDDF = tCDDF & Server.HTMLEncode(request.form("ocdTF" & strFieldName))
End if
End if
tCDDF = tCDDF & "</select>"
if IsFieldDataInvalid(strFieldName) Then
tCDDF = tCDDF & HTMLCheckField
End if
Else
if not ADORecordset.eof then
tCDDF = ADORecordset.Fields(strFieldName).Value & vbCRLF
End if
End if
Response.write tCDDF
end sub
public sub DisplayFieldAsButtons(strFieldName, strBoundValues, strDisplayValues, strDefaultValue, strOrientation)
dim tCDDF '- variable to hold return value of function
dim tarrBound
dim tarrDisplay
dim tintI
tcDDF = ""
tarrBound = split(strBoundValues,";")
tarrDisplay = split(strDisplayValues,";")
if UCASE(strOrientation) = "VERTICAL" Then
tCDDF = tCDDF & "<TABLE Border=0>"
End if
for tintI = 0 to UBound(tarrBound)
if UCASE(strOrientation) = "VERTICAL" Then
tCDDF = tCDDF & "<TR><TD>"
End if
tCDDF = tCDDF & "<INPUT TYPE=RADIO "
tCDDF = tCDDF & "NAME=""ocdTF" & Server.HTMLEncode(strFieldName) & """ "
tCDDF = tCDDF & "VALUE="""
if tarrBound(tintI) <> "" Then
tCDDF = tCDDF & Server.HTMLEncode(tarrBound(tintI))
End if
tCDDF = tCDDF & """ "
if request.form("ocdTF" & strFieldName) <> "" Then
if tarrBound(tintI) = request.form("ocdTF" & strFieldName) Then
tCDDF = tCDDF & "CHECKED "
End if
Else
if (SQLID <>"" or SQLWHERE <> "") And FormStatus = "" AND InvalidFields = "" Then
if not ADORecordset.eof Then
if tarrBound(tintI) = "" and isnull(ADORecordset.Fields(strFieldName).Value) Then
tCDDF = tCDDF & "CHECKED "
Elseif Cstr(tarrBound(tintI)) = Cstr(ADORecordset.Fields(strFieldName)).Value Then
tCDDF = tCDDF & "CHECKED "
End if
Else
if tarrBound(tintI) = strDefaultValue Then
tCDDF = tCDDF & "CHECKED "
end if
End if
Elseif (SQLID = "" and SQLWHERE = "") and FormStatus = "" AND InvalidFields = "" Then
if tarrBound(tintI) = strDefaultValue Then
tCDDF = tCDDF & "CHECKED "
end if
end if
End if
tCDDF = tCDDF & ">"
if strDisplayValues = "" Then
if tarrBound(tintI) <> "" then
tCDDF = tCDDF & Server.HTMLEncode(tarrBound(tintI))
End if
Else
if tarrDisplay(tintI) <> "" then
tCDDF = tCDDF & Server.HTMLEncode(tarrDisplay(tintI))
End if
End if
if UCASE(strOrientation) = "VERTICAL" Then
tCDDF = tCDDF & "</TD></TR>"
End if
next
if UCASE(strOrientation) = "VERTICAL" Then
tCDDF = tCDDF & "</TABLE>"
End if
if IsFieldDataInvalid(strFieldName) Then
tCDDF = tCDDF & HTMLCheckField
End if
Response.write tCDDF
end sub
public sub DisplayFieldAsRelatedValues(strFieldName, strConstraintSQL, strDefaultValue, strAttributes)
dim tCDDF, tvarvalue, tintI, trsConstraint, tarrGetRows, trsConstraintFieldCount
set trsConstraint = Server.CreateObject("ADODB.Recordset")
Call trsConstraint.open (strConstraintSQL, ADOConnection)
if not trsConstraint.eof Then
tarrGetRows = trsConstraint.getrows
trsConstraintFieldCount = trsConstraint.Fields.Count
Else
trsConstraintFieldCount = 0
End if
trsConstraint.close
set trsConstraint = nothing
tcDDF = ""
Select Case EditMode
Case "Add", "Edit"
tCDDF = tCDDF & "<SELECT "
tCDDF = tCDDF & "NAME=""ocdTF" & Server.HTMLEncode(strFieldName) & """ "
tCDDF = tCDDF & strAttributes & ">"
if trsConstraintFieldCount <> 0 Then
tCDDF = tCDDF & "<OPTION "
tCDDF = tCDDF & "VALUE="""" "
If FormMode = "Save" Then
if request.form("ocdTF" & strFieldName) = "" Then
tCDDF = tCDDF & "SELECTED"
End if
ElseIf EditMode = "Add" Then
if strDefaultValue = "" Then
tCDDF = tCDDF & "SELECTED"
End if
Else
tvarvalue = ADORecordset.Fields(strFieldName).Value
If isnull(tvarvalue) Then
tCDDF = tCDDF & "SELECTED"
End if
End if
tCDDF = tCDDF & "></OPTION>"
' response.write "XXXXXX"
for tintI = 0 to UBound(tarrGetRows,2)
tCDDF = tCDDF & "<OPTION "
tCDDF = tCDDF & "VALUE="""
if not isnull(tarrGetRows(0,tIntI)) Then 'trsConstraint(0)) Then
if tarrGetRows(0,tIntI) = "" Then
'response.write "SSSSSSSSSSS"
tCDDF = tCDDF & Server.HTMLEncode(FormEStringToken)
Else
'x "TTTTTTTTTTT"
tCDDF = tCDDF & Server.HTMLEncode(tarrGetRows(0,tIntI))
End if
End if
tCDDF = tCDDF & """ "
if FormMode = "Save" Then
if isnull(tarrGetRows(0,tIntI)) Then
if request.form("ocdTF" & strFieldName) = "" Then
tCDDF = tCDDF & "SELECTED "
End if
Else
if tarrGetRows(0,tIntI) = "" and request.form("ocdTF" & strFieldName) = FormEStringToken Then
tCDDF = tCDDF & "SELECTED "
Elseif Cstr(tarrGetRows(0,tIntI)) = request.form("ocdTF" & strFieldName) Then
tCDDF = tCDDF & "SELECTED "
End if
End if
ElseIf EditMode = "Add" Then
if isnull(tarrGetRows(0,tIntI)) Then
if strDefaultValue = "" Then
tCDDF = tCDDF & "SELECTED "
End if
Else
if Cstr(tarrGetRows(0,tIntI)) = strDefaultValue Then
tCDDF = tCDDF & "SELECTED "
End if
End if
ElseIf EditMode = "Edit" Then
if isnull(tarrGetRows(0,tIntI)) And IsNull(tvarvalue) Then
tCDDF = tCDDF & "SELECTED "
Elseif isnull(tarrGetRows(0,tIntI)) Or IsNull(tvarvalue) Then
'no match
Else
if Cstr(tarrGetRows(0,tIntI)) = Cstr(tvarvalue) Then
tCDDF = tCDDF & "SELECTED "
End if
End if
End if
tCDDF = tCDDF & ">"
if trsConstraintFieldCount > 1 then
if not isnull(tarrGetRows(1,tIntI)) then
if Cstr(tarrGetRows(1,tIntI)) = FormEstringToken Then
tCDDF = tCDDF & Server.HTMLEncode(FormEstringToken)
Else
tCDDF = tCDDF & Server.HTMLEncode(tarrGetRows(1,tIntI))
End if
End if
Else
if not isnull(tarrGetRows(0,tIntI)) then
tCDDF = tCDDF & Server.HTMLEncode(tarrGetRows(0,tIntI))
End if
End if
tCDDF = tCDDF & "</OPTION>"
next
End if
tCDDF = tCDDF & "</select>"
If FormMode = "Save" Then
if IsFieldDataInvalid(strFieldName) Then
tCDDF = tCDDF & HTMLCheckField
End if
End if
Case "ReadOnly"
if not isnull(ADORecordset.Fields(strFieldName).Value) then
tCDDF= tCDDF & server.htmlencode(ADORecordset.Fields(strFieldName).Value)
end if
Case Else
tCDDF = ""
End Select
Response.write tCDDF
end sub
private function IsFieldDataInvalid(strpFieldName)
dim isdiintI
dim isdiarrT
dim tmpInvalidFields
IsFieldDataInvalid = False
isdiarrT = split(InvalidFields,";")
for isdiintI = 0 to ubound(isdiarrT)
if strpFieldName = isdiarrT(isdiintI) Then
IsFieldDataInvalid = True
exit for
End if
Next
end function
Public sub Open()
on error resume next
dim fldTemp, fmRequest, strSQL, strURL, QS, strSQLIDX, rsIDX, strSQLWherePK, strCDp, arrSQLSelectPK, intTemp
if not EnablePrimaryKeyLink Then
SQLWhere = ""
Else
if SQLWhere = "" Then
SQLWhere = Request.Querystring("SQLWHERE")
end if
End if
if SQLID = "" and SQLWhere = "" Then
SQLID = Request.Querystring("SQLID")
if not allowmultidelete then
if not isnumeric(SQLID) Then
SQLID = ""
End if
end if
End if
if (SQLID <> "" or SQLWHERE <>"") then
If AllowEdit then
EditMode = "Edit"
Else
EditMode = "ReadOnly"
End if
Else
If AllowAdd then
EditMode = "Add"
Else
EditMode = "NotFound"
End if
End if
If Request.form("ocdEditSave") <> "" Then
FormMode = "Save"
Else
FormMode = "View"
End if
SQLSelect = Replace(SQLSelect,";","")
SQLWhere = Replace(SQLWhere,";","")
SQLFrom = Replace(SQLFrom,";","")
SQLID = Replace(SQLID,";","")
if request.form("ocdEditNew") <> "" Then
strURL =request.servervariables("SCRIPT_NAME") & "?sqlid="
for each QS in Request.Querystring
if UCASE(QS) <> "SQLID" AND UCASE(QS) <> "SQLWHERE" Then
strURL = strURL & "&" & QS & "=" & Server.URLEncode(Request.Querystring(QS))
End if
next
Call Close()
response.clear
response.redirect (strURL)
ElseIf (request("ocdEditCancel") <> "") and (request("ocdEditCancelPage") <> "") Then
if CallOnCancel Then
call ocdOnCancel()
End if
strURL =request("ocdEditCancelPage") & "?sqlid="
for each QS in Request.Querystring
if UCASE(QS) <> "SQLID" AND UCASE(QS) <> "OCDEDITDELETE" AND UCASE(QS) <> "SQLWHERE" Then
strURL = strURL & "&" & QS & "=" & Server.URLEncode(Request.Querystring(QS))
End if
next
response.clear
response.redirect strURL
response.end
ElseIf (request.form("ocdEditCancel") <> "") or ((request.form("ocdEditDelete") <> "" or request.querystring("ocdEditDelete") <> "") and request("ocdEditConfirm") <> "" and not AllowDelete) Then
if CallOnCancel Then
call ocdOnCancel()
End if
strURL = request.servervariables("SCRIPT_NAME") & "?sqlid=" & SQLID & "&sqlwhere=" & server.urlencode(SQLWHERE)
for each QS in Request.Querystring
if UCASE(QS) <> "SQLID" AND UCASE(QS) <> "OCDEDITDELETE" AND UCASE(QS) <> "SQLWHERE" Then
strURL = strURL & "&" & QS & "=" & Server.URLEncode(Request.Querystring(QS))
End if
next
Call Close()
response.clear
response.redirect (strURL)
Elseif (request("ocdEditDelete") <> "") and request("ocdEditConfirm") = "" and CallBeforeDelete Then
call ocdBeforeDelete
End if
set ADOConnection = server.CreateObject("ADODB.Connection")
if ADOMode = 0 Then
if FormMode <> "Save" AND NOT ((request.form("ocdEditDelete") <> "" or request.querystring("ocdEditDelete") <> "") and request("ocdEditconfirm") <> "") Then 'nothing to update, use read only connection
ADOConnection.mode = 1 'adModeRead
End if
Else
ADOConnection.Mode = ADOMode
End if
Call ADOConnection.Open (SQLConnect, SQLUser, SQLPass)
If DatabaseTYpe = "" Then
DatabaseType = getDatabaseType(ADOConnection)
End if
If SQLSelectID = "" AND SQLSelectPK = "" And EnablePrimaryKeyLink Then
set rsIDX = server.createobject("ADODB.Recordset")
if UCASE(ADOConnection.provider) <> "MICROSOFT.JET.OLEDB.3.51" Then
strSQLIDX = "Select * From " & SQLFrom & " WHERE 1 = 2"
rsIDX.CursorLocation = 2
' response.write request.querystring("sqlfrom_A") & strSQLIDX
Call rsIDX.Open (strSQLIDX, ADOConnection, 0, 1 )'adOpenForwardOnly, adLockReadOnly
if err.number <>0 Then
response.write err.description
response.end
end if
for each fldTemp in rsIDX.Fields
if CBool(fldTemp.Properties("ISAUTOINCREMENT")) = True Then
SQLSelectID = fldTemp.Name
exit for
End if
next
rsIDX.close
set rsIDX = nothing
end if
If SQLSelectID = "" and SQLSelectPK = "" Then 'determin primary key fields dynamically
SQLSelectPK = getPKFields(ADOConnection,DatabaseType,SQLFrom,quoteprefix,quotesuffix)
End if
End if
If SQLSelectPK = "" AND SQLSelectID = "" And EditMode = "Edit" Then
EditMode = "View" 'can't id record for update
end if
If (request("ocdEditDelete") <> "") and request("ocdEditConfirm") <> "" Then
if instr(1, SQLFrom ,",") = 0 Then
strSQL = "DELETE FROM " & FormatForSQL(SQLFrom,DatabaseType,"AddSQLIdentifier")
Else
strSQL = "DELETE FROM " & SQLFrom
end if
if SQLID <> "" Then
if AllowMultiDelete and instr(SQLID,",") <> 0 THen
strSQL = strSQL & " WHERE (" & SQLSelectID & " IN ( " & SQLID & " ) "
Else
strSQL = strSQL & " WHERE (" & SQLSelectID & " = " & SQLID
End if
Else
strSQL = strSQL & " WHERE (" & SQLWHERE
End if
if SQLWhereExtra <> "" Then
strSQL = strSQL & ") AND " & SQLWhereExtra & ""
Else
strSQL = strSQL & ")"
End if
if ( not EnablePrimaryKeyLink and (not Isnumeric(SQLID) or SQLWHERE <> "")) Then
err.Raise 17
exit sub
Else
if CallPreDelete Then
call ocdPreDelete()
End if
ADOConnection.Execute( strSQL )
End if
'have to redirect to a different screen after a delete
if err.number= 0 Then
if CallAfterDelete Then
call ocdAfterDelete
end if
'if redirect not triggered in sub, goto new record
strURL = request.servervariables("SCRIPT_NAME") & "?sqlid="
for each QS in Request.Querystring
if UCASE(QS) <> "SQLID" AND UCASE(QS) <> "ocdEditDelete" AND UCASE(QS) <> "SQLWHERE" Then
strURL = strURL & "&" & QS & "=" & Server.URLEncode(Request.Querystring(QS))
End if
next
Call Close()
response.clear
response.redirect (strURL)
Else
FormStatus = FormStatus & err.description
err.clear
End if
End if
if sqlSelect = "" Then
sqlSelect = "*"
end if
set ADORecordset = server.createobject("ADODB.Recordset")
If FormMode = "View" Then
strSQL = "Select " & SQLSelect & " from " & FormatForSQL(SQLFrom,DatabaseType,"AddSQLIdentifier")
If EditMode = "Edit" Then
if SQLID <> "" Then
if DatabaseType = "Oracle" Then
strSQL = strSQL & " Where (" & SQLSelectID & " = " & SQLID
Else
strSQL = strSQL & " Where (" & FormatForSQL(SQLSelectID,DatabaseType,"AddSQLIdentifier") & " = " & SQLID
End if
Else
strSQL = strSQL & " Where (" & SQLWHERE
End if
if SQLWhereExtra <> "" Then
strSQL = strSQL & ") AND " & SQLWhereExtra & ""
Else
strSQL = strSQL & ")"
End if
ADORecordset.CursorLocation = 3
Call ADORecordset.open (strSQL , ADOConnection , 3, 3)'adOpenStatic , adLockReadOnly
if Err.Number <> 0 Then
err.clear
EditMode = "NotFound"
FormStatus = FormStatus & HTMLNotFound
Elseif ADORecordset.eof then
EditMode = "NotFound"
FormStatus = FormStatus & HTMLNotFound
End if
set ADORecordset.activeconnection = nothing
Else
ADORecordset.CursorLocation = 3
strSQL = "SELECT " & SQLSelect & " FROM " & FormatForSQL(SQLFrom,DatabaseType,"AddSQLIdentifier") & " WHERE 1=2"
Call ADORecordset.open (strSQL , ADOConnection , 3, 1) 'adOpenStatic , adLockReadOnly
set ADORecordset.activeconnection = nothing
end if
ElseIf FormMode = "Save" Then
if (AllowEdit and EditMode="Edit") Then
strSQL = "SELECT " & SQLSelect & " FROM " & FormatForSQL(SQLFrom,DatabaseType,"AddSQLIdentifier")
if SQLSelectID <> "" and SQLWHERE = "" Then
if DatabaseType = "Oracle" Then
strSQL = strSQL & " Where (" & SQLSelectID & " = " & SQLID
Else
strSQL = strSQL & " WHERE (" & FormatForSQL(SQLSelectID,DatabaseType,"AddSQLIdentifier") & " = " & SQLID
End if
Else
strSQL = strSQL & " WHERE (" & SQLWHERE
End if
if SQLWhereExtra <> "" Then
strSQL = strSQL & ") AND " & SQLWhereExtra & ""
Else
strSQL = strSQL & ")"
End if
' response.write strSQL
if FormEditConnect and DatabaseType <> "MySQL" and DatabaseType <> "Oracle" Then
ADORecordset.CursorLocation = 2
' Response.write "X"
Else
ADORecordset.CursorLocation = 3
End if
Call ADORecordset.open (strSQL , ADOConnection , 3, 3) ' adOpenStatic , adLockOptimistic
if Not FormEditConnect Then
set ADORecordset.activeconnection = nothing
End if
if err.number <> 0 Then
FormStatus = FormStatus & err.description
Else
if ADORecordset.eof then
EditMode = "NotFound"
FormStatus = FormStatus & HTMLNotFound
Elseif CallBeforeUpdate Then
call ocdBeforeUpdate()
End if
End if
Elseif (AllowAdd and EditMode="Add") Then
strSQL = "SELECT " & SQLSelect & " FROM " & FormatForSQL(SQLFrom,DatabaseType,"AddSQLIdentifier") & " WHERE 1=2"
if DatabaseType = "MySQL" or DatabasetYpe = "Oracle" or not FormEditConnect Then
ADORecordset.CursorLocation = 3
Else
ADORecordset.CursorLocation = 2
End if
if FormEditConnect Then
Call ADORecordset.open (strSQL , ADOConnection , 3, 3) ' adOpenStatic , adLockOptimistic
Else
Call ADORecordset.open (strSQL , ADOConnection , 3, 4) ' adOpenStatic , adLockOptimistic adLockBatchOptimistic = 4
End if
ADORecordset.AddNew
if Not FormEditConnect Then
set ADORecordset.activeconnection = nothing
End if
if err.number <> 0 Then
FormStatus = FormStatus & err.description
Elseif CallBeforeInsert Then
call ocdBeforeInsert
End if
End if
dim v1,v2
if FormStatus = "" and InvalidFields = "" Then
for each fmRequest in Request.Form
Select Case UCASE(fmRequest)
Case "ocdTFS_GENERATION"
'Don't process
Case Else
Select Case left(fmRequest ,5)
Case "ocdCT"
set fldTemp = ADORecordset.Fields(CSTR(mid( fmRequest ,6)))
v1 = fldTemp.Value
If UCASE( fldTemp.Name) = UCase(SQLSelectID ) Then
'dont update
ElseIf ((CBool( fldTemp.Attributes And &H00000020)) And Request.Form( "ocdCB" & CSTR(mid( fmRequest ,6)) ) = "") and fldTemp.Type <> 72 Then 'adFldIsNullable=&H00000020
'null check
if not isnull(v1) Then
fldTemp.Value = null
end if
Else
select Case fldTemp.Type
Case 72 'adGUID
'no update
Case 11 'adBoolean
If Request.Form( "ocdCB" & CSTR(mid( fmRequest ,6)) ) <> "" Then
if isnull(V1) THen
fldTemp.Value = True
Elseif not v1 Then
fldTemp.Value = True
End if
Else
if isnull(V1) THen
' response.write "YY"
fldTemp.Value = False
Elseif v1 Then
fldTemp.Value = False
Elseif UCASE(EditMode) ="ADD" Then
' fldTemp.Value = False
End if
End if
Case Else
if Cstr(Request.Form( "ocdCB" & CSTR(mid( fmRequest ,6)) )) = "" and CSTR(Request.form("ndchf" & CSTR(mid( fmRequest ,6)))) = "" Then
' if not isnull(v1) Then
fldTemp.Value = null
' End if
Else
if request.form("ocdCB" & CSTR(mid( fmRequest ,6))) = "" Then
fldTemp.Value = Request.Form( "ndchf" & CSTR(mid( fmRequest ,6)) )
Else
fldTemp.Value = Request.Form( "ocdCT" & CSTR(mid( fmRequest ,6)) )
End if
if err.number <> 0 Then
FormStatus = FormStatus & HTMLUpdateFieldFails & mid(fmRequest,6) & ": " & err.description & "<BR>"
InvalidFields = InvalidFields & mid(fmRequest,6) & ";"
err.clear
End if
end if
End select
End if
Case "ocdTF"
if EditMode = "Add" and request.Form(fmRequest) = "" Then
'don't set value, lets default be used
Else
'response.write v1
set fldTemp = ADORecordset.Fields(CSTR(mid( fmRequest ,6)))
' response.write fldTemp.name
' response.write fldTemp.Type
v1 = fldTemp.Value
If UCASE( fldTemp.Name) = UCase(SQLSelectID ) Then
'dont update
ElseIf ((CBool( fldTemp.Attributes And &H00000020)) And (Request.Form( fmRequest ) = FormNullToken or Request.Form( fmRequest ) = "" ) ) and fldTemp.Type <> 72 Then 'adFldIsNullable=&H00000020
'null check
if FormNullToken = v2 Then
if not isnull(v1) Then
fldTemp.Value = null
End if
Else
Select Case fldTemp.Type
Case 129,230,200,202
if (v1) = FormNullToken Then
fldTemp.Value = null
Else
fldTemp.Value = ""
End if
Case Else
if not isnull(v1) Then
fldTemp.Value = null
End if
End Select
End if
Else
select Case fldTemp.Type
Case 72 'adGUID
Case 11 'adBoolean
select case Request.Form( fmRequest )
Case "True", "Yes", "-1"
if isnull(v1) Then
fldTemp.Value = True
Elseif not v1 Then
fldTemp.Value = True
End if
Case "False", "No","0"
if isnull(v1) Then
fldTemp.Value = False
Elseif v1 Then
fldTemp.Value = False
end if
Case else
if not isnull(v1) Then
fldTemp.Value = null
End if
End select
Case Else
if Cstr(Request.Form( fmRequest )) = "" Then
if not isnull(v1) Then
fldTemp.Value = null
End if
Else
if fldTemp.Type = 135 and IsDate(request.form(fmRequest)) and DatabaseType = "MySQL" Then
if isnull(v1) Then
fldTemp.Value = CDate(Request.Form( fmRequest ))
Elseif not v1= CDate(Request.Form( fmRequest )) Then
fldTemp.Value = CDate(Request.Form( fmRequest ))
End if
Elseif fldTemp.Type = 135 Then
if isnull(v1) Then
fldTemp.Value = CDate(Request.Form( fmRequest ))
elseif not v1= CDate(Request.Form( fmRequest )) Then
fldTemp.Value = CDate(Request.Form( fmRequest ))
End if
ElseIf fldTemp.Type = 3 Then
'response.write (v1)
v1 = fldTemp.value
if isnull(v1) Then
fldTemp.Value = CInt(Request.Form( fmRequest ))
Elseif not Cstr((v1)) = Cstr((Request.Form( fmRequest ))) Then
'response.write fldTemp.name
'response.write Cstr((fldTemp.Value))
'response.write Cstr((v1)) = Cstr((Request.Form( fmRequest )))
' response.end
fldTemp.Value = CLng(Request.Form( fmRequest ))
End if
'response.write "1"
' response.end
ElseIf fldTemp.Type = 6 Then
if isnull(v1) Then
fldTemp.Value = CCur(Request.Form( fmRequest ))
Elseif not Cstr(v1)= Cstr(Request.Form( fmRequest )) Then
fldTemp.Value = CCur(Request.Form( fmRequest ))
End if
ElseIf fldTemp.Type = 202 or fldTemp.Type = 203 or fldTemp.Type = 201 or fldTemp.Type = 200 Then
' if fldTemp.Name = "SubCategory" then
' on error goto 0
' response.write "<p>v1"
' response.write v1
' response.write "<p>v2"
' response.write v2
' response.write "<p>"
' response.write FormEstringToken
'f response.end
' End if
if isnull(v1) Then
fldTemp.Value = CStr(Request.Form( fmRequest ))
elseif v1 <> "" and CStr(Request.Form( fmRequest )) = FormEStringToken Then
fldTemp.Value = ""
elseif v1 = "" and CStr(Request.Form( fmRequest )) = FormEStringToken Then
fldTemp.Value = ""
Elseif not Cstr((v1))= CStr(Request.Form( fmRequest )) Then
fldTemp.Value = CStr(Request.Form( fmRequest ))
End if
ElseIf fldTemp.Type = 131 or fldTemp.Type = 130 Then
v2 = (Cstr(Request.Form( fmRequest )) )
If isnull(v1) THen
fldTemp.Value = Request.Form( fmRequest )
Elseif not Cstr((v1)) = (v2) Then
'response.write Request.Form( fmRequest )
fldTemp.Value = Request.Form( fmRequest )
End if
Else
fldTemp.Value = Request.Form( fmRequest )
End if
' response.write err.number
Select Case Err.number
Case 0
Case -2147217887
FormStatus = FormStatus & " " & HTMLUpdateFieldFails & " " & mid(fmRequest,6) & ": " & HTMLOLEError & "<BR>"
InvalidFields = InvalidFields & mid(fmRequest,6) & ";"
'response.write "X"
err.clear
Case Else
FormStatus = FormStatus & " " & HTMLUpdateFieldFails & " " & mid(fmRequest,6) & ": " & err.description & "<BR>"
InvalidFields = InvalidFields & mid(fmRequest,6) & ";"
err.clear
End Select
'err.clear
end if
End select
End if
End if
Case Else 'don't process
End select 'form field prefix
End Select 'form field name
if err.number <> 0 Then
FormStatus = FormStatus & HTMLStatusFieldError & mid(fmRequest,6) & ": " & err.description & "<BR>"
InvalidFields = InvalidFields & mid(fmRequest,6) & ";"
err.clear
End if
next 'Form Field to update
End if 'Update form field switch
if InvalidFields = "" and FormStatus = "" Then
if Not FormEditConnect Then
ADORecordset.ActiveConnection = ADOConnection
ADORecordset.UpdateBatch
Else
' on error resume next
'response.write ADORecordset.Source
ADORecordset.Update
End if
' response.end
if err.number <> 0 Then
FormStatus = FormStatus & err.description & "<BR>"
ADORecordset.CancelUpdate
err.clear
on error goto 0
Else
if EditMode = "Add" Then
if EditMode = "Add" and FormMode = "Save" and not DatabaseType = "Oracle" and DatabaseType <> "MySQL" Then 'redirect to newly added record
ADORecordset.movelast
End if
if CallAfterInsert Then
call ocdAfterInsert()
End if
Else
if CallAfterUpdate Then
call ocdAfterUpdate()
End if
End if
End if
Else
ADORecordset.CancelUpdate
End if
if not FormEditConnect Then
ADORecordset.ActiveConnection = nothing
End if
If FormStatus = "" and InvalidFields = "" Then 'start record redirect
if SQLSelectID <> "" Then
strURL =request.servervariables("SCRIPT_NAME") & "?sqlwhere=&sqlid="
on error resume next
dim tmpCNewID
tmpCNewID = ADORecordset.Fields(SQLSelectID).Value
if err.number <> 0 Then
err.clear
ADORecordset.Resync 1,2
tmpCNewID = ADORecordset.Fields(SQLSelectID).Value
if err.number <> 0 Then
tmpCNewID = ""
End if
err.clear
End if
strURL = strURL & tmpCNewID
Else 'determine primary key to redirect
strURL =request.servervariables("SCRIPT_NAME") & "?sqlid=&sqlwhere="
strSQLWHEREPK = ""
strCDp = ""
arrSQLSelectPK = split(SQLSelectPK,",")
For intTemp = 0 To UBound(arrSQLSelectPK)
strSQLWHEREPK = strSQLWHEREPK & FormatForSQL(Cstr(arrSQLSelectPK(intTemp)),DatabaseType,"AddSQLIdentifier") & "="
' Response.write ADORecordset.Fields(arrSQLSelectPK(intTemp)).Type
select case ADORecordset.Fields(arrSQLSelectPK(intTemp)).Type
Case 2, 3, 4, 5, 14, 16, 17, 18, 19, 20, 21, 128, 131, 204, 6, 11 'adSmallInt, adInteger, adSingle, adDouble, adDecimal, adTinyInt, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adBigInt, adUnsignedBigInt, adBinary, adNumeric, adVarBinary, adLongVarBinary, adCurrency, adBoolean
strCDp = ""
Case 135, 7, 133, 134 'adDBTimeStamp, adDate, adDBDate, adDBTime
if DatabaseType = "Access" Then
strCDp = "#"
Else
strCDp = "'"
End if
Case 8, 129, 130, 200, 201, 202, 203 'adBSTR, adChar, adWChar, adVarChar, adLongVarChar, adVarWChar, adLongVarWChar
strCDp = "'"
End Select
select case ADORecordset.Fields(arrSQLSelectPK(intTemp)).Type
Case 8, 129, 130, 200, 201, 202, 203 'adBSTR, adChar, adWChar, adVarChar, adLongVarChar, adVarWChar, adLongVarWChar
strSQLWHEREPK = strSQLWHEREPK & strCDp & Replace(ADORecordset.Fields(arrSQLSelectPK(intTemp)).Value,"'","''") & strCDp & " AND "
Case 135, 7, 133, 134 'adDBTimeStamp, adDate, adDBDate, adDBTime
strSQLWHEREPK = strSQLWHEREPK & strCDp & FormatForSQL(ADORecordset.Fields(arrSQLSelectPK(intTemp)).Value, DatabaseType, "SafeDate") & strCDp & " AND "
Case Else
strSQLWHEREPK = strSQLWHEREPK & strCDp & ADORecordset.Fields(arrSQLSelectPK(intTemp)).Value & strCDp & " AND "
End Select
next
if strSQLWHEREPK <> "" Then
strSQLWHEREPK = left(strSQLWHEREPK,len(strSQLWHEREPK)-5)
end if
strURL = strURL & Server.URLEncode(strSQLWHEREPK)
End if
for each QS in Request.Querystring
if UCASE(QS) <> "SQLID" AND UCASE(QS) <> "SQLWHERE" Then
strURL = strURL & "&" & QS & "=" & Server.URLEncode(Request.Querystring(QS))
End if
next
call Close()
response.clear
response.redirect (strURL)
End if 'End recordset redirect
End if 'end Form Mode Switch
end sub
Public Sub Display(strTemplate)
dim strTemp
dim QS
Select Case UCASE(strTemplate)
Case "STATUS"
if FormStatus <> "" Then
Response.write HTMLStatusStart & FormStatus & HTMLStatusEnd
End if
Case "START"
strTemp = ""
strTemp = strTemp &"<FORM METHOD=""POST"" action=""" & request.servervariables("SCRIPT_NAME") & "?"
for each QS in Request.Querystring
if UCASE(QS) <> "ocdEditDelete" and UCASE(QS) <> "NDCUSTOMMESSAGE" Then
strTemp = strTemp & QS & "=" & Server.URLEncode(Request.Querystring(QS)) & "&"
End if
next
strTemp = strTemp & """ " & HTMLAttribForm & ">"
Response.write strTemp
Case "END"
Response.write "</form>"
Case "BUTTONS"
strTemp = ""
If EditMode <> "NotFound" Then
if instr(SQLID, ",") = 0 Then
If AllowAdd or AllowEdit then
strTemp = strTemp & "<INPUT TYPE=hidden Name=ocdCSSFix>"
strTemp = strTemp & "<INPUT Name=ocdEditSave " & HTMLAttribSaveBtn & ">"
End if
if AllowAdd and (SQLID <> "" or SQLWHERE <> "" ) then
strTemp = strTemp & "<INPUT Name=ocdEditNew " & HTMLAttribNewBtn & ">"
end if
strTemp = strTemp & "<INPUT Name=ocdEditCancel " & HTMLAttribCancelBtn & ">"
if AllowDelete and (SQLID <> "" or SQLWHERE <> "") then
strTemp = strTemp & "<INPUT Name=ocdEditDelete " & HTMLAttribDeleteBtn & ">"
End if
Response.write strTemp
End If
end if
End Select
end sub
Public Sub Close
on error resume next
ADORecordset.close
set ADORecordset = nothing
ADOConnection.close
set ADOConnection = nothing
err.clear
end sub
End Class
%>