UTE - Universal Table Editor
Contents of this page
UTE.ASP
<%@ language = "VBScript" %>
<%
'---------------------------------------------------------------------------
'
' Project: UTE - (U)niversal ASP (T)able (E)ditor
'
' Module: UTE Active Server Page
'
' Version: 3.01
'
' Comments: This module does the following things:
' 1. Creates the HTML frame for UTE class
' 2. Inserts the UTE class
'
'---------------------------------------------------------------------------
'
' (c) in 2000-2003 by Tom Wellige
' http://www.wellige.com mailto:tom@wellige.com
'
' This project is released under the "GNU General Public License (GPL)"
' http://www.gnu.org/licenses/gpl.html
'
' and is maintained on SourceForge at
' http://sourceforge.net/projects/ute-asp/
'
' and can also be found on CodeProject at
' http://www.codeproject.com/asp/ute.asp
'
'---------------------------------------------------------------------------
option explicit
%>
<!--#include file ="ute_definition.inc"-->
<%
Dim sDSN
' To use a DSN-Less Connection use the following sDSN definition.
' !!! By using this, UTE is able to detect Primary Keys accurately.
sDSN = "Provider=Microsoft.Jet.OLEDB.4.0;" &_
"Data Source=" & Server.MapPath("test.mdb")
' To use a DSN (ODBC) Connection use the following sDSN defintion.
' You need to setup an ODBC data source.
' !!! By using this, UTE is *NOT* always able to detect Primary Keys accurately.
' sDSN = "test"
Dim ute
Set ute = new clsUTE
ute.DBName = "TEST.MDB" ' Name of Database. For display purpose only
'ute.ReadOnly = True ' readonly mode
'ute.ListTables = False ' display toolbutton to list all tables within db
'ute.Filters = False ' display toolbutton to define and activate filters
'ute.Export = False ' display toolbutton to export all data to CSV file
'ute.SQL = False ' display toolbutton to show current sql statement
'ute.Definitions = False ' display toolbutton to show field defintions
ute.Init sDSN ' init must be called *before* any HTML code is
' is written, otherwise the export feature doesn't work !
%>
<!doctype html public "-//W3C//DTD HTML 3.2//EN">
<html>
<head>
<title><%=ute.HeadLine%> - Universal Table Editor</title>
<link rel="stylesheet" type="text/css" href="ute_style.css">
</head>
<body bgcolor="#FFFFFF" link="#0000A0" vlink="#0000A0" alink="#0000A0">
<%
ute.Draw
Set ute = Nothing
%>
</body>
</html>
UTE_CLASS.INC
<%
'---------------------------------------------------------------------------
'
' Project: UTE - (U)niversal ASP (T)able (E)ditor
'
' Module: UTE class
'
' Version: 3.01
'
' Comments: This module does the following things:
' 1. Defines the class "clsUTE" with all it's
' properties and functions.
'
'---------------------------------------------------------------------------
'
' (c) in 2000-2003 by Tom Wellige
' http://www.wellige.com mailto:tom@wellige.com
'
' This project is released under the "GNU General Public License (GPL)"
' http://www.gnu.org/licenses/gpl.html
'
' and is maintained on SourceForge at
' http://sourceforge.net/projects/ute-asp/
'
' and can also be found on CodeProject at
' http://www.codeproject.com/asp/ute.asp
'
'---------------------------------------------------------------------------
'
' Public Properties (R = read, W = write)
'
' DBName R/W Name of Database. For display purpose only.
'
' HeadLine R Headline of page (e.g. to be used as <title>)
' TableName R Name of current table
'
' ReadOnly W display table in readonly mode (default: false)
'
' ListTables W display toolbutton to list all tables (default: true)
' Filters W display toolbutton to define and activate filters (default: true)
' Export W display toolbutton to export all data to CSV file (default: true)
' SQL W display toolbutton to show current sql statement (default: true)
' Definitions W display toolbutton to show field defintions (default: true)
'
' ImageDir R/W name of image directory, must end with "/" (default: images/ )
'
' Public Functions
' Init (sDSN) must be called *before* any other HTML output
' Draw () writes complete HTML code
' getHTML () returns complete HTML code
'
'---------------------------------------------------------------------------
Class clsUTE
'-----------------------------------------------------------------------
' Private Member Variables
'
Private m_DB ' database connection object
Private m_RS ' recordset object
Private m_RSForm ' recordset object for form view
Private m_sSQL ' SQL statement being used to read data from db
Private m_nMode ' View mode: mdTable, mdForm, mdExport
Private m_nFormMode ' Form mode: mdEdit, mdInsert, mdDelete
Private m_sDSN ' odbc connect string
Private m_sDBName ' database name (for display purpose only)
Private m_sTable ' table name
Private m_nPage ' current page
Private m_nPageSize ' size of current page
Private m_bSortFields ' sort fields alphabetically (columns) ?
Private m_bViewDefinitions ' show field definitions ?
Private m_bViewSQL ' show sql statement ?
Private m_bAutoPKDetection ' detect primary key fields ?
Private m_bSubmitted ' form was submitted
Private m_bReadOnly ' display table in readonly mode
Private m_bListTables ' display toolbutton to list all tables within db
Private m_bFilters ' display toolbutton to define and activate filters
Private m_bShowExportLink ' display toolbutton to export all data to CSV file
Private m_bShowSQL ' display toolbutton to show current sql statement
Private m_bShowDefLink ' display toolbutton to show field defintions
Private m_PrimaryKeyFields() ' array holding names of all primary key fields
Private m_PrimaryKeyTypes() ' array holding types of all primary key fields
Private m_StandardFields() ' array holding names of all other fields
Private m_StandardTypes() ' array holding types of all other fields
Private m_SortFields() ' array holding names of the fields for the ORDER BY clause
Private m_SortFieldsOrder() ' array holding the directions for the ORDER BY clause
Private m_nNumberOfFilters ' number of filters
Private m_FilterFields() ' array holding names of fields of the filters
Private m_FilterCompares() ' array holding the comparisons for the filters
Private m_FilterValues() ' array holding the values of the filters
Private m_FilterCombines() ' array holding the combinitions of the filters
Private m_sHeadLine ' Headline
Private m_sUTEScript ' name of UTE script file
Private m_sIMAGEDir ' name of image directory
Private m_nRecord ' number of record to be edited/deleted
Private m_ErrorField()
Private m_ErrorMessage()
'-----------------------------------------------------------------------
' Property Functions
'
' ---- HeadLine (read) ----
Property Get HeadLine()
HeadLine = m_sHeadLine
End Property
' ---- DBName (read/write) ----
Property Let DBName(s)
m_sDBName = s
End Property
Property Get DBName()
DBName = m_sDBName
End Property
' ---- TableName (read) ----
Property Get TableName()
TableName = m_sTable
End Property
' ---- ReadOnly (write) ----
Property Let ReadOnly(b)
m_bReadOnly = b
End Property
' ---- ListTables (write) ----
Property Let ListTables(b)
m_bListTables = b
End Property
' ---- Definitions (write) ----
Property Let Definitions(b)
m_bShowDefLink = b
End Property
' ---- SQL (write) ----
Property Let SQL(b)
m_bShowSQL = b
End Property
' ---- Filter (write) ----
Property Let Filters(b)
m_bFilters = b
End Property
' ---- Export (write) ----
Property Let Export(b)
m_bShowExportLink = b
End Property
' ---- ImageDir (read/write)----
Property Let ImageDir(s)
m_sIMAGEDir = s
End Property
Property Get ImageDir()
ImageDir = m_sIMAGEDir
End Property
'-----------------------------------------------------------------------
' Private Member Functions
'
''----------------------------------------------------------------------
'' Name: Class_Initialize
'' ================
''
'' Constructor.
''
''----------------------------------------------------------------------
Private Sub Class_Initialize()
Set m_DB = Server.CreateObject("ADODB.Connection")
Set m_RS = Server.CreateObject("ADODB.Recordset")
m_nMode = DEF_MODE
m_nFormMode = DEF_FORM_MODE
m_sDSN = ""
m_sDBName = ""
m_sTable = ""
m_sSQL = ""
m_nPage = DEF_PAGE
m_nPageSize = DEF_PAGE_SIZE
m_bSortFields = DEF_SORT_FIELDS
m_bViewDefinitions = DEF_VIEW_DEFINITIONS
m_bViewSQL = DEF_VIEW_SQL
m_bAutoPKDetection = DEF_PK_DETECTION
m_bSubmitted = False
m_bReadOnly = DEF_READONLY
m_bListTables = DEF_LIST_TABLES
m_bShowDefLink = DEF_SHOW_DEF_LINK
m_bShowExportLink = DEF_EXPORT_LINK
m_bShowSQL = DEF_SQL_LINK
m_bFilters = DEF_FILTERS
m_nNumberOfFilters = DEF_NUM_FILTER
m_sUTEScript = Request.ServerVariables("SCRIPT_NAME")
m_sIMAGEDir = DEF_IMAGE_DIR
Redim m_PrimaryKeyFields(0)
Redim m_PrimaryKeyTypes(0)
Redim m_StandardFields(0)
Redim m_StandardTypes(0)
Redim m_SortFields(0)
Redim m_SortFieldsOrder(0)
Redim m_FilterFields(0)
Redim m_FilterCompares(0)
Redim m_FilterValues(0)
Redim m_FilterCombines(0)
Redim m_ErrorField(0)
Redim m_ErrorMessage(0)
End Sub
''----------------------------------------------------------------------
'' Name: Class_Terminate
'' ===============
''
'' Destructor.
''
''----------------------------------------------------------------------
Private Sub Class_Terminate()
Redim m_PrimaryKeyFields(0)
Redim m_StandardFields(0)
Set m_RS = Nothing
Set m_DB = Nothing
if IsObject(m_RSForm) then
Set m_RSForm = Nothing
end if
End Sub
''----------------------------------------------------------------------
'' Name: SetURLParameter
'' ===============
''
'' Sets a given parameter to a URL parameter string. If the parameter is
'' already present in the URL string it will be updated, otherwise it will
'' simply be added.
''
'' Parameter:
'' sURL URL string to set/update the parameter in
'' sName name of parameter to be set
'' sValue value of parameter to be set
''
'' return value:
'' string new URL parameter string
''
''----------------------------------------------------------------------
Private Function SetURLParameter (sURL, sName, sValue)
Dim iPos
Dim sLink, sReturn, sLeft, sRight
sLink = sURL
sReturn = ""
if InStr(sLink, sName & "=") <> 0 then
' update exisiting parameter
iPos = InStr(sLink, sName & "=")
sLeft = Left(sLink, iPos+Len(sName))
sRight = Right(sLink, Len(sLink) - (iPos + Len(sName)))
if InStr(sRight, "&") <> 0 then
' at least one following parameter
iPos = InStr(sRight, "&")
sRight = Right(sRight, Len(sRight)-iPos+1)
sReturn = sReturn & sLeft & sValue & sRight
else
' no following parameter
sReturn = sReturn & sLeft & sValue
end if
else
' add parameter
if Len(sLink) <> 0 then
sReturn = sReturn & sLink & "&" & sName & "=" & sValue
else
sReturn = sReturn & sName & "=" & sValue
end if
end if
SetURLParameter = sReturn
End Function
''----------------------------------------------------------------------
'' Name: buildLink
'' =========
''
'' Returns a string containing all UTE relevant URL parameters, such
'' as tablename, page or primary key fields.
''
'' Parameter:
'' sCurrent current URL string
''
'' return value:
'' string link
''
''----------------------------------------------------------------------
Private Function buildLink (sCurrent)
Dim i
Dim sReturn, sDefs, sSQL, sSort, sSubmitted
' preserve current URL string
sReturn = sCurrent
sSQL = "0"
if m_bViewSQL then sSQL = "1"
sDefs = "0"
if m_bViewDefinitions then sDefs = "1"
sSort = "0"
if m_bSortFields then sSort = "1"
sSubmitted = "0"
if m_bSubmitted then sSubmitted = "1"
' set all UTE URL params
sReturn = SetURLParameter(sReturn, sParamTable, m_sTable)
sReturn = SetURLParameter(sReturn, sParamMode, CStr(m_nMode))
sReturn = SetURLParameter(sReturn, sParamFormMode, CStr(m_nFormMode))
sReturn = SetURLParameter(sReturn, sParamPage, CStr(m_nPage))
sReturn = SetURLParameter(sReturn, sParamPageSize, CStr(m_nPageSize))
sReturn = SetURLParameter(sReturn, sParamSQL, sSQL)
sReturn = SetURLParameter(sReturn, sParamDefs, sDefs)
sReturn = SetURLParameter(sReturn, sParamSortFields, sSort)
sReturn = SetURLParameter(sReturn, sParamSubmitted, sSubmitted)
sReturn = SetURLParameter(sReturn, sParamRecord, CStr(m_nRecord))
' add primary key fields
for i = 1 to UBound(m_PrimaryKeyFields)
sReturn = SetURLParameter(sReturn, sParamPKey & CStr(i), m_PrimaryKeyFields(i))
next
' add sort fields
for i = 1 to UBound(m_SortFields)
sReturn = SetURLParameter(sReturn, sParamSort & CStr(i), m_SortFields(i))
sReturn = SetURLParameter(sReturn, sParamSortDir & CStr(i), m_SortFieldsOrder(i))
next
buildLink = sReturn
End Function
''----------------------------------------------------------------------
'' Name: GetLink
'' =======
''
'' Adds the given parameter to a compelte UTE link. An UTE link includes
'' all possible URL parameters and is used to switch table pages or open
'' the record form.
''
'' Parameter:
'' sScript name of script to be called, e.g. ute.asp
'' sCurrent current link, if "" the function build a complete new link
'' sParam name of parameter to be set
'' sValue value to be set
''
'' return value:
'' string complete link
''
''----------------------------------------------------------------------
Private Function GetLink ( sScript, sCurrent, sParam, sValue )
Dim iPos
Dim sReturn, sLeft, sRight
' check if we already have a complete UTE URL string ?
if InStr(sCurrent, sParamMode) <> 0 then
' use current link
iPos = InStr(sCurrent, "?")
sReturn = "&" & Right(sCurrent, Len(sCurrent)-iPos)
else
' build new link
sReturn = "&" & buildLink(sCurrent)
end if
sReturn = SetURLParameter(sReturn, sParam, sValue)
' add script name, repleace leading "&" by "?"
sReturn = sScript & "?" & Right(sReturn, Len(sReturn)-1)
GetLink = sReturn
End Function
''----------------------------------------------------------------------
'' Name: RemoveParameter
'' ===============
''
'' Removes parameter from given URL string.
''
'' Parameter:
'' sLink string containing the link
'' sParam parameter name
''
'' return value:
'' string
''
''----------------------------------------------------------------------
Private Function RemoveParameter ( sLink, sParam )
Dim sLeft, sRight, sReturn
Dim iPos
sReturn = sLink
while InStr(sReturn, sParam & "=") <> 0
iPos = InStr(sReturn, sParam & "=")
sLeft = Left(sReturn, iPos-1)
iPos = InStr(iPos, sReturn, "&")
sRight = ""
if iPos <> 0 then sRight = Right(sReturn, Len(sReturn)-iPos)
sReturn = sLeft & sRight
wend
if Right(sReturn, 1) = "&" then sReturn = Left(sReturn, Len(sReturn)-1)
RemoveParameter = sReturn
End Function
''----------------------------------------------------------------------
'' Name: RemoveCountedParameters
'' =======================
''
'' Removes so called "counted parameters" like "pkey[n]" or "sort[n]"
'' from the given link. The start counter defines the start value for [n].
'' E.g.: sParam = sort, nStartCounter = 2
'' -> removes all sort2, sort3, sort4, ... from the link
''
'' Parameter:
'' sLink string containing the link
'' sParam parameter name
'' nStarCount start counter
''
'' return value:
'' string
''
''----------------------------------------------------------------------
Private Function RemoveCountedParameters ( sLink, sParam, nStartCount )
Dim sReturn
Dim n
n = nStartCount
sReturn = sLink
while InStr(sReturn, sParam & CStr(n)) <> 0
sReturn = RemoveParameter(sReturn, sParam & CStr(n))
n = n + 1
wend
RemoveCountedParameters = sReturn
End Function
''----------------------------------------------------------------------
'' Name: GetParameter
'' ============
''
'' Gets all parameters from URL and throw excaption if neccessary.
''
'' Parameter:
'' none
''
'' return value:
'' none
''
''----------------------------------------------------------------------
Private Sub GetParameter()
Dim i, j
Dim sTemp
Dim sError
' ---- ODBC connect string ----
if m_sDSN = "" then
'"Invalid ODBC Connection String"
sError = STR_ERR_1001
err.Raise vbObjectError + 1001, "ute_table", sError
end if
' ---- Tablename ----
if Request.QueryString(sParamTable) <> "" then
m_sTable = Request.QueryString(sParamTable)
else
m_nMode = MD_DATABASE
end if
' ---- Tablename ----
m_sTable = Request.QueryString(sParamTable)
if m_bListTables then
' if no table set, display all tables within database
if Request.QueryString(sParamTable) = "" then
m_nMode = MD_DATABASE
end if
else
' if no table set throw error
if Request.QueryString(sParamTable) = "" then
'"Missing ""%1"" URL parameter."
sError = Replace(STR_ERR_1002, "%1", sParamTable)
err.Raise vbObjectError + 1002, "ute_table", sError
end if
end if
' ---- Mode ----
if Request.QueryString(sParamMode) <> "" then
sTemp = Request.QueryString(sParamMode)
if not IsNumeric(sTemp) then
'"Invalid ""%1"" URL parameter. Must be numeric."
sError = Replace(STR_ERR_1003, "%1", sParamMode)
err.Raise vbObjectError + 1003, "ute_table", sError
end if
m_nMode = CInt(sTemp)
if (m_nMode < MD_DATABASE) or (m_nMode > MD_FILTER) then
'"Invalid ""%1"" URL parameter. Must be ""1"", ""2"" or ""3""."
sError = Replace(STR_ERR_1004, "%1", sParamMode)
err.Raise vbObjectError + 1004, "ute_table", sError
end if
end if
' ---- FormMode ----
if Request.QueryString(sParamFormMode) <> "" then
sTemp = Request.QueryString(sParamFormMode)
if not IsNumeric(sTemp) then
'"Invalid ""%1"" URL parameter. Must be numeric."
sError = Replace(STR_ERR_1003, "%1", sParamFormMode)
err.Raise vbObjectError + 1003, "ute_table", sError
end if
m_nFormMode = CInt(sTemp)
if (m_nFormMode < 1) or (m_nFormMode > 3) then
'"Invalid ""%1"" URL parameter. Must be ""1"", ""2"" or ""3""."
sError = Replace(STR_ERR_1004, "%1", sParamFormMode)
err.Raise vbObjectError + 1004, "ute_table", sError
end if
end if
' ---- Page ----
if Request.QueryString(sParamPage) <> "" then
sTemp = Request.QueryString(sParamPage)
if not IsNumeric(sTemp) then
'"Invalid ""%1"" URL parameter. Must be numeric."
sError = Replace(STR_ERR_1003, "%1", sParamPage)
err.Raise vbObjectError + 1003, "ute_table", sError
end if
m_nPage = CInt(sTemp)
end if
' ---- Page Size ----
if Request.QueryString(sParamPageSize) <> "" then
sTemp = Request.QueryString(sParamPageSize)
if not IsNumeric(sTemp) then
'"Invalid ""%1"" URL parameter. Must be numeric."
sError = Replace(STR_ERR_1003, "%1", sParamPageSize)
err.Raise vbObjectError + 1003, "ute_table", sError
end if
m_nPageSize = CInt(sTemp)
end if
' ---- Sort Fields Alphabetically ----
if Request.QueryString(sParamSortFields) <> "" then
sTemp = Request.QueryString(sParamSortFields)
if (sTemp <> "0") and (sTemp <> "1") then
'"Invalid ""%1"" URL parameter. Must be either ""%2"" or ""%3""."
sError = Replace(STR_ERR_1005, "%1", sParamSortDir)
sError = Replace(sError, "%2", "0")
sError = Replace(sError, "%3", "1")
err.Raise vbObjectError + 1005, "ute_table", sError
end if
m_bSortFields = (sTemp = "1")
end if
' ---- View SQL Statement ----
if Request.QueryString(sParamSQL) <> "" then
sTemp = Request.QueryString(sParamSQL)
if (sTemp <> "0") and (sTemp <> "1") then
'"Invalid ""%1"" URL parameter. Must be either ""%2"" or ""%3""."
sError = Replace(STR_ERR_1005, "%1", sParamSQL)
sError = Replace(sError, "%2", "0")
sError = Replace(sError, "%3", "1")
err.Raise vbObjectError + 1005, "ute_table", sError
end if
m_bViewSQL = (sTemp = "1")
end if
' ---- View Field Definitions ----
if Request.QueryString(sParamDefs) <> "" then
sTemp = Request.QueryString(sParamDefs)
if (sTemp <> "0") and (sTemp <> "1") then
'"Invalid ""%1"" URL parameter. Must be either ""%2"" or ""%3""."
sError = Replace(STR_ERR_1005, "%1", sParamDefs)
sError = Replace(sError, "%2", "0")
sError = Replace(sError, "%3", "1")
err.Raise vbObjectError + 1005, "ute_table", sError
end if
m_bViewDefinitions = (sTemp = "1")
end if
' ---- Submitted ----
if Request.QueryString(sParamSubmitted) <> "" then
sTemp = Request.QueryString(sParamSubmitted)
if (sTemp <> "0") and (sTemp <> "1") then
'"Invalid ""%1"" URL parameter. Must be either ""%2"" or ""%3""."
sError = Replace(STR_ERR_1005, "%1", sParamSubmitted)
sError = Replace(sError, "%2", "0")
sError = Replace(sError, "%3", "1")
err.Raise vbObjectError + 1005, "ute_table", sError
end if
m_bSubmitted = (sTemp = "1")
end if
' ---- Record ----
if Request.QueryString(sParamRecord) <> "" then
sTemp = Request.QueryString(sParamRecord)
if not IsNumeric(sTemp) then
'"Invalid ""%1"" URL parameter. Must be numeric."
sError = Replace(STR_ERR_1003, "%1", sParamRecord)
err.Raise vbObjectError + 1003, "ute_table", sError
end if
m_nRecord = CInt(sTemp)
end if
' ---- Primary Keys ----
i = 1
while Request.QueryString(sParamPKey & CStr(i)) <> ""
' switch off auto primary key detection
m_bAutoPKDetection = False
' "-1" will force SetPrimaryKeyFieldType to set the field type properly
AddPrimaryKeyField Request.QueryString(sParamPKey & CStr(i)), -1
i = i + 1
wend
' ---- Sort Field ----
' This can be either "sort" (for compatebility purpose) or "sort[n]"
if Request.QueryString(sParamSort) <> "" then
AddSortField Request.QueryString(sParamSort)
if Request.QueryString(sParamSortDir) <> "" then
sTemp = LCase(Request.QueryString(sParamSortDir))
if (sTemp <> SORT_ASC) and (sTemp <> SORT_DESC) then
'"Invalid ""%1"" URL parameter. Must be either ""%2"" or ""%3""."
sError = Replace(STR_ERR_1005, "%1", sParamSortDir)
sError = Replace(sError, "%2", SORT_ASC)
sError = Replace(sError, "%3", SORT_DESC)
err.Raise vbObjectError + 1005, "ute_table", sError
end if
AddSortOrder sTemp
else
' default sort order
AddSortOrder DEF_SORT_DIR
end if
else
i = 1
while Request.QueryString(sParamSort & CStr(i)) <> ""
AddSortField Request.QueryString(sParamSort & CStr(i))
if Request.QueryString(sParamSortDir & CStr(i)) <> "" then
sTemp = LCase(Request.QueryString(sParamSortDir & CStr(i)))
if (sTemp <> SORT_ASC) and (sTemp <> SORT_DESC) then
'"Invalid ""%1"" URL parameter. Must be either ""%2"" or ""%3""."
sError = Replace(STR_ERR_1005, "%1", sParamSortDir & CStr(i))
sError = Replace(sError, "%2", SORT_ASC)
sError = Replace(sError, "%3", SORT_DESC)
err.Raise vbObjectError + 1005, "ute_table", sError
end if
AddSortOrder sTemp
else
' default sort order
AddSortOrder DEF_SORT_DIR
end if
i = i + 1
wend
end if
' ---- Number of Filters ----
if Request.QueryString(sParamFilterCount) <> "" then
sTemp = Request.QueryString(sParamFilterCount)
if not IsNumeric(sTemp) then
'"Invalid ""%1"" URL parameter. Must be numeric."
sError = Replace(STR_ERR_1003, "%1", sParamFilterCount)
err.Raise vbObjectError + 1003, "ute_table", sError
end if
m_nNumberOfFilters = CInt(sTemp)
end if
' ---- General Filter Parameters ----
if Request.QueryString(sParamFilterCompare & "1") <> "" then
' ---- Filter Compares ----
i = 1
while (Request.QueryString(sParamFilterCompare & CStr(i)) <> "") and (i <= m_nNumberOfFilters)
Redim Preserve m_FilterCompares(UBound(m_FilterCompares)+1)
m_FilterCompares(UBound(m_FilterCompares)) = Request.QueryString(sParamFilterCompare & CStr(i))
i = i + 1
wend
' ---- Filter Fields ----
for j = 1 to i
Redim Preserve m_FilterFields(UBound(m_FilterFields)+1)
m_FilterFields(UBound(m_FilterFields)) = Request.QueryString(sParamFilterField & CStr(j))
next
' ---- Filter Values ----
for j = 1 to i
Redim Preserve m_FilterValues(UBound(m_FilterValues)+1)
m_FilterValues(UBound(m_FilterValues)) = Request.QueryString(sParamFilterValue & CStr(j))
next
' ---- Filter Combines ----
for j = 1 to i - 1
Redim Preserve m_FilterCombines(UBound(m_FilterCombines)+1)
m_FilterCombines(UBound(m_FilterCombines)) = Request.QueryString(sParamFilterCombine & CStr(j))
next
end if
End Sub
''----------------------------------------------------------------------
'' Name: AddPrimaryKeyField
'' ==================
''
'' Add's a primary key field to the array
''
'' Parameter:
'' sField name of field
'' nType type of field
''
'' return value:
'' none
''
''----------------------------------------------------------------------
Private Sub AddPrimaryKeyField (sField, nType)
Redim Preserve m_PrimaryKeyFields(UBound(m_PrimaryKeyFields)+1)
Redim Preserve m_PrimaryKeyTypes(UBound(m_PrimaryKeyFields))
m_PrimaryKeyFields(UBound(m_PrimaryKeyFields)) = sField
m_PrimaryKeyTypes(UBound(m_PrimaryKeyTypes)) = nType
End Sub
''----------------------------------------------------------------------
'' Name: AddStandardField
'' ================
''
'' Add's a "standard" field to the array
''
'' Parameter:
'' sField name of field
'' nType type of field
''
'' return value:
'' none
''
''----------------------------------------------------------------------
Private Sub AddStandardField (sField, nType)
Redim Preserve m_StandardFields(UBound(m_StandardFields)+1)
Redim Preserve m_StandardTypes(UBound(m_StandardFields))
m_StandardFields(UBound(m_StandardFields)) = sField
m_StandardTypes(UBound(m_StandardTypes)) = nType
End Sub
''----------------------------------------------------------------------
'' Name: AddSortField
'' ============
''
'' Add's a field the table should be sorted after to the array
''
'' Parameter:
'' sField name of field
''
'' return value:
'' none
''
''----------------------------------------------------------------------
Private Sub AddSortField (sField)
Redim Preserve m_SortFields(UBound(m_SortFields)+1)
m_SortFields(UBound(m_SortFields)) = sField
End Sub
''----------------------------------------------------------------------
'' Name: AddSortOrder
'' ============
''
'' Add's the sort order of a field to the array
''
'' Parameter:
'' sField name of field
''
'' return value:
'' none
''
''----------------------------------------------------------------------
Private Sub AddSortOrder (sOrder)
Redim Preserve m_SortFieldsOrder(UBound(m_SortFieldsOrder)+1)
m_SortFieldsOrder(UBound(m_SortFieldsOrder)) = sOrder
End Sub
''----------------------------------------------------------------------
'' Name: SetPrimaryKeyFieldType
'' ======================
''
'' Sets the type of a primary key field to the types array if the
'' current type is -1. This will be used if there are primary keys
'' being set via URL. In this case we need to set the type afterwards.
''
'' Parameter:
'' sField Name of the field
'' nType Type of the field
''
'' return value:
'' none
''
''----------------------------------------------------------------------
Private Sub SetPrimaryKeyFieldType ( sField, nType )
Dim i
for i = 1 to UBound(m_PrimaryKeyFields)
if (m_PrimaryKeyFields(i) = sField) and (m_PrimaryKeyFields(i) = -1) then
m_PrimaryKeyTypes(i) = nType
end if
next
End Sub
''----------------------------------------------------------------------
'' Name: IsKnownPrimaryKey
'' =================
''
'' Checks if the given field is already known as primary key
''
'' Parameter:
'' sField Name of field
''
'' return value:
'' boolean
''
''----------------------------------------------------------------------
Private Function IsKnownPrimaryKey ( sField )
Dim i
Dim bReturn
bReturn = False
for i = 1 to UBound(m_PrimaryKeyFields)
if m_PrimaryKeyFields(i) = sField then bReturn = True
next
IsKnownPrimaryKey = bReturn
End Function
''----------------------------------------------------------------------
'' Name: IsPrimaryKey_inDBSchema
'' =======================
''
'' Checks if the given field is defined in db schema
''
'' Parameter:
'' sField name of field
''
'' return value:
'' boolean
''
''----------------------------------------------------------------------
Private Function IsPrimaryKey_inDBSchema ( sField )
Dim bReturn
bReturn = False
Dim rsSchema
Set rsSchema = Server.CreateObject("ADODB.Recordset")
rsSchema.CursorType = adOpenDynamic
' Getting the adSchemaPrimaryKeys will only supported by oledb
' providers, not by simple ODBC connections. They will throw an
' error.
on error resume next
Set rsSchema = m_DB.openSchema(adSchemaPrimaryKeys)
if Err = 0 then
do while (not rsSchema.EOF) and (not bReturn)
if LCase(rsSchema("TABLE_NAME")) = LCase(m_sTable) then
if LCase(rsSchema("COLUMN_NAME")) = LCase(sField) then
bReturn = True
end if
end if
rsSchema.MoveNext
loop
rsSchema.Close
end if
on error goto 0
Set rsSchema = Nothing
IsPrimaryKey_inDBSchema = bReturn
End Function
''----------------------------------------------------------------------
'' Name: PrintSchema
'' ===========
''
'' For debug purpose only ! Prints the conntents of the given schema.
''
'' Parameter:
''
'' return value:
''
''----------------------------------------------------------------------
Private Sub PrintSchema
Dim rsSchema, fld
Set rsSchema = Server.CreateObject("ADODB.Recordset")
rsSchema.CursorType = adOpenDynamic
on error resume next
Set rsSchema = m_DB.openSchema(adSchemaPrimaryKeys)
'Set rsSchema = m_DB.openSchema(adSchemaIndexes)
'Set rsSchema = m_DB.openSchema(adSchemaColumns)
'Set rsSchema = m_DB.openSchema(adSchemaTables)
'Set rsSchema = m_DB.openSchema(adSchemaProviderTypes)
if err = 0 then
while not rsSchema.EOF
response.write "-----------------------------------------------------------------------<br>" & vbCrLf
for each fld in rsSchema.Fields
response.write fld.name & ": " & fld.value & "<br>" & vbCrLf
next
rsSchema.MoveNext
wend
end if
on error goto 0
response.end
End Sub
''----------------------------------------------------------------------
'' Name: SortFields
'' ==========
''
'' Sort given array ascending
''
'' Parameter:
'' fields array hoöding the fields to be sorted
'' types array holding the types of the fields
''
'' return value:
'' none
''
''----------------------------------------------------------------------
Private Sub SortFields ( ByRef fields, ByRef types )
Dim pa
Dim pb
Dim temp
' standard bubble sort
for pa = 1 to UBound(fields) - 1
for pb = 1 to UBound(fields) - pa
if fields(pb) > fields(pb + 1) then
' swap fields
temp = fields(pb)
fields(pb) = fields(pb + 1)
fields(pb + 1) = temp
' swap types
temp = types(pb)
types(pb) = types(pb + 1)
types(pb + 1) = temp
end if
next
next
End Sub
''----------------------------------------------------------------------
'' Name: AnalyzeTable
'' ============
''
'' Analyzing Table for Primary Key Fields and "normal" Fields.
''
'' Parameter:
'' none
''
'' return value:
'' none
''
''----------------------------------------------------------------------
Private Sub AnalyzeTable()
Dim fld
Dim rsTemp
Set rsTemp = Server.CreateObject("ADODB.Recordset")
rsTemp.Open "[" & m_sTable & "]", m_DB, adOpenStatic, adLockReadOnly, adCmdTable
for each fld in rsTemp.fields
if m_bAutoPKDetection then
' check if field is in schema marked as primary key
if IsPrimaryKey_inDBSchema(fld.name) then
if Not(IsKnownPrimaryKey(fld.name)) then
AddPrimaryKeyField fld.name, fld.type
end if
' treat field as primary key field if the following flags are set:
' -> (KeyColumn) OR (Fixed and ((not Updateable) and (not UnknownUpdateable)))
elseif ((fld.attributes and adFldKeyColumn) <> 0) or _
( _
((fld.attributes and adFldFixed) <> 0) and _
( _
((fld.attributes and adFldUpdatable) = 0) and _
((fld.attributes and adFldUnknownUpdatable) = 0)) _
) then
if Not(IsKnownPrimaryKey(fld.name)) then
AddPrimaryKeyField fld.name, fld.type
end if
' this is no primary key field
else
if Not(IsKnownPrimaryKey(fld.name)) then
AddStandardField fld.name, fld.type
end if
end if
else
' the primary keys have been set via URL
if IsKnownPrimaryKey(fld.name) then
' we need to set the type since we only got the name from the URL
SetPrimaryKeyFieldType fld.name, fld.type
else
AddStandardField fld.name, fld.type
end if
end if
next
rsTemp.Close
Set rsTemp = Nothing
' sort fields (ascending) in array if wanted
if m_bSortFields then
SortFields m_PrimaryKeyFields, m_PrimaryKeyTypes
SortFields m_StandardFields, m_StandardTypes
end if
End Sub
''----------------------------------------------------------------------
'' Name: getPoweredBy
'' ============
''
'' Returns HTML code for "powered by UTE"
''
'' Parameter:
'' none
''
'' return value:
'' string
''
''----------------------------------------------------------------------
Private Function getPoweredBy ()
Dim sReturn
sReturn = _
"<a href=""" & sUTELink & """ target=""_blank"" class=""ute_link"" " & _
"title=""" & sUTELink & """>" & sUTELongName & "</a>"
sReturn = Replace(STR_POWERED_BY, "%1", sReturn)
sReturn = Replace(sReturn, "%2", sUTEVersion)
getPoweredBy = "<div class=""ute_powered_by"">" & sReturn & "</div>"
End Function
''--------------------------------------------------------------------------
'' Name: AddWhere
'' ========
''
'' Adds WHERE clause to SQL Statement
''
'' Parameter:
'' sName name of field
'' nType type of field
'' sValue value of field, if empty the value is taken from the field object
'' sCompare comparison like "=" or ">"
'' sCombine combinition of clauses like "AND" or "OR"
'' bFirst is the the first where clause ?
''
'' return value:
'' string
''
''--------------------------------------------------------------------------
Private Function AddWhere ( sName, nType, sValue, sCompare, sCombine, bFirst )
Dim sReturn, sSepChar
sSepChar = ""
select case nType
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 = " " & sCombine & " "
end if
select case nType
case adSingle, adDouble, adCurrency
sValue = Replace(sValue, ",", ".")
case adBSTR, adVariant, adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar
sValue = Replace(sValue, "'", "''")
end select
AddWhere = sReturn & sName & " " & sCompare & " " & sSepChar & sValue & sSepChar
End Function
''----------------------------------------------------------------------
'' Name: getFieldType
'' ============
''
'' Returns the type of the given field
''
'' Parameter:
'' sName Name of the field
''
'' return value:
'' Inbteger
''
''----------------------------------------------------------------------
Private Function getFieldType ( sName )
Dim i, bFound
Dim nReturn
nReturn = 0
i = 0
while (not bFound) and (i < UBound(m_PrimaryKeyFields))
i = i + 1
if m_PrimaryKeyFields(i) = sName then
nReturn = m_PrimaryKeyTypes(i)
bFound = True
end if
wend
i = 0
while (not bFound) and (i < UBound(m_StandardFields))
i = i + 1
if m_StandardFields(i) = sName then
nReturn = m_StandardTypes(i)
bFound = True
end if
wend
getFieldType = nReturn
End Function
''----------------------------------------------------------------------
'' Name: getFilter
'' =========
''
'' Returns complete Filter SQL statement
''
'' Parameter:
'' none
''
'' return value:
'' string
''
''----------------------------------------------------------------------
Private Function getFilter ()
Dim sReturn, sCombine
Dim i, bFirst
bFirst = True
sReturn = ""
sCombine = ""
for i = 1 to m_nNumberOfFilters
if i > 1 then sCombine = m_FilterCombines(i-1)
sReturn = sReturn & AddWhere( _
m_FilterFields(i), _
getFieldType(m_FilterFields(i)), _
m_FilterValues(i), _
m_FilterCompares(i), _
sCombine, _
bFirst)
bFirst = False
next
GetFilter = sReturn
End Function
''----------------------------------------------------------------------
'' Name: getAllRecordsFromDB
'' ===================
''
'' Creates SQL statement to get all records from table, opens
'' and configures recordset.
''
'' Parameter:
'' none
''
'' return value:
'' none
''
''----------------------------------------------------------------------
Private Sub getAllRecordsFromDB ()
Dim i
Dim s
m_sSQL = "SELECT * FROM " & m_sTable
' if no sort field is given select one
if UBound(m_SortFields) = 0 then
if UBound(m_PrimaryKeyFields) <> 0 then
AddSortField m_PrimaryKeyFields(1)
AddSortOrder SORT_ASC
elseif UBound(m_StandardFields) <> 0 then
AddSortField m_StandardFields(1)
AddSortOrder SORT_ASC
end if
end if
' add WHERE clause
if UBound(m_FilterFields) >= m_nNumberOfFilters then
m_sSQL = m_sSQL & getFilter
end if
' add ORDER BY clause
if UBound(m_SortFields) <> 0 then
s = " ORDER BY "
for i = 1 to UBound(m_SortFields)
s = s & m_SortFields(i)
if m_SortFieldsOrder(i) = SORT_DESC then s = s & " DESC"
s = s & ", "
next
' cut trailing ", "
s = Left(s, Len(s)-2)
m_sSQL = m_sSQL & s
end if
on error resume next
m_RS.Open m_sSQL, m_DB, adOpenStatic
if Err <> 0 then
if UBound(m_FilterCompares) <> 0 then
' redirect to filter page and display original error message
s = Request.QueryString
s = getLink(m_sUTEScript, s, sParamMode, MD_FILTER)
s = getLink(m_sUTEScript, s, sParamSubmitted, "0")
s = getLink(m_sUTEScript, s, sParamFilterError, Server.URLEncode(Err.description))
Response.Redirect s
else
Response.Write CStr(Hex(Err)) & ": " & Err.Description
Response.End
end if
end if
m_RS.PageSize = m_nPageSize
if m_nPage > m_RS.PageCount then
m_nPage = m_RS.PageCount
end if
if m_nPage <> 0 then
m_RS.AbsolutePage = m_nPage
end if
End Sub
'-----------------------------------------------------------------------
' Inlcude all mode specific private class functions
'
%>
<!--#include file ="ute_class_database.inc"-->
<!--#include file ="ute_class_table.inc"-->
<!--#include file ="ute_class_form.inc"-->
<!--#include file ="ute_class_export.inc"-->
<!--#include file ="ute_class_filter.inc"-->
<%
'-----------------------------------------------------------------------
' Public Member Functions
'
''----------------------------------------------------------------------
'' Name: Init
'' ====
''
'' Read all paramters, analyze table and prepares HTML output.
''
'' Parameter:
'' sDSN ODBC connection string
'' bReadOnly Display table in readonly mode
''
'' return value:
'' none
''
''----------------------------------------------------------------------
Public Sub Init( sDSN )
m_sDSN = sDSN
' read all other parameters from URL
GetParameter()
' are there filters to be set ?
if m_nMode = MD_FILTER then
if m_bSubmitted then
' set filter and redirect to table
UpdateFilter
end if
end if
' calculate headline
select case m_nMode
case MD_DATABASE
m_sHeadLine = m_sDBName
case MD_TABLE
m_sHeadLine = m_sTable
case MD_FILTER
m_sHeadLine = STR_DEF_FILTER
case MD_FORM
select case m_nFormMode
case MD_INSERT
m_sHeadLine = STR_INSERT
case MD_EDIT
m_sHeadLine = STR_EDIT
case MD_DELETE
m_sHeadLine = STR_DELETE
end select
end select
' open database connection
m_DB.Open m_sDSN
if m_nMode <> MD_DATABASE then
' get all fields from table
AnalyzeTable
if m_nMode <> MD_FILTER then
' load all records from db
getAllRecordsFromDB
end if
if m_nMode = MD_EXPORT then
' create csv data and send it to the response stream
ExportToStream
end if
if m_nMode = MD_FORM then
' update record and redirect to table
Update
end if
end if
End Sub
''----------------------------------------------------------------------
'' Name: Draw
'' ====
''
'' Writes entire HTML code directly to stream.
''
'' Parameter:
'' none
''
'' return value:
'' none
''
''----------------------------------------------------------------------
Public Sub Draw()
select case m_nMode
case MD_DATABASE
Response.Write buildHTML_Database
case MD_TABLE
Response.Write buildHTML_Table
case MD_FORM
Response.Write buildHTML_Form
case MD_FILTER
Response.Write buildHTML_Filter
end select
End Sub
''----------------------------------------------------------------------
'' Name: getHTML
'' =======
''
'' Returns entire HTML code as string.
''
'' Parameter:
'' none
''
'' return value:
'' string entire UTE HTML code
''
''----------------------------------------------------------------------
Public Function getHTML()
select case m_nMode
case MD_DATABASE
getHTML = buildHTML_Database
case MD_TABLE
getHTML = buildHTML_Table
case MD_FORM
getHTML = buildHTML_Form
case MD_FILTER
getHTML = buildHTML_Filter
end select
End Function
End Class
%>
UTE_DEFINITION.INC
<%
'---------------------------------------------------------------------------
'
' Project: UTE - (U)niversal ASP (T)able (E)ditor
'
' Module: UTE Definitions
'
' Version: 3.01
'
' Comments: All of UTEs "easy to change" definitions.
'
'---------------------------------------------------------------------------
'
' (c) in 2000-2003 by Tom Wellige
' http://www.wellige.com mailto:tom@wellige.com
'
' This project is released under the "GNU General Public License (GPL)"
' http://www.gnu.org/licenses/gpl.html
'
' and is maintained on SourceForge at
' http://sourceforge.net/projects/ute-asp/
'
' and can also be found on CodeProject at
' http://www.codeproject.com/asp/ute.asp
'
'---------------------------------------------------------------------------
%>
<!--#include file ="adovbs.inc"-->
<!--#include file ="ute_language_en.inc"-->
<!--#include file ="ute_adolib.inc"-->
<!--#include file ="ute_class.inc"-->
<%
'---------------------------------------------------------------------------
' Definitions
'
Const sUTELongName = "Universal Table Editor"
Const sUTEShortName = "UTE"
Const sUTEVersion = "v3.01"
Const sUTELink = "http://www.codeproject.com/asp/ute.asp"
'---------------------------------------------------------------------------
' "public" URL Parameter
'
Const sParamTable = "name" ' name of table
Const sParamPKey = "pkey" ' e.g. pkey1, pkey2, ... pkeyn
Const sParamSortFields = "sorted" ' sort fields alphabetically (1=true, 0=false, default=0)
'---------------------------------------------------------------------------
' "private" URL Parameter
'
Const sParamPage = "page" ' current page
Const sParamPageSize = "pagesize" ' page size (default=10)
Const sParamSort = "sort" ' sort field
Const sParamSortDir = "sortdir" ' sort direction (asc, desc, default=asc)
Const sParamMode = "mode" ' MD_TABLE, MD_FORM, MD_EXPORT
Const sParamFormMode = "formmode" ' MD_INSERT, MD_EDIT, MD_DELETE
Const sParamRecord = "record" ' editing or deleting record
Const sParamDefs = "definitions" ' show field definitions (1=true, 0=false, default=0)
Const sParamSQL = "sql" ' show sql statement (1=true, 0=false, default=0)
Const sParamSubmitted = "submitted" ' flag to signal that page was submitted (1=true, 0=false)
Const sParamFilterCount = "fltcount" ' number of filters
Const sParamFilterField = "fltfield" ' field to filter for, e.g.: fltfield1, fltfield1, ... fltfieldn
Const sParamFilterCompare = "fltcomp" ' comparison for filter, e.g.: fltcomp1, fltcomp2, ... fltcompn
Const sParamFilterValue = "fltvalue" ' value to filter for, e.g.: fltvalue1, fltvalue2, ... fltvaluen
Const sParamFilterCombine = "fltcomb" ' combine filters, e.g.: fltcomb1, fltcomb2, ... fltcombn
Const sParamFilterError = "flterror" ' error message
'---------------------------------------------------------------------------
' form fields
'
Const sFormUTEFieldPrefix = "?" ' all UTE own form fields statr with this character. This must
' not be a valid SQL fieldname character to ensure integrity
Const sFormButton = "ute_form_button" ' name of ok and cancel buttons in form
Const sFormIdentField = "ute_ident_field" ' name of field to identify a record to be edited
Const sFormIdentType = "ute_ident_type" ' type of field to identify a record to be edited
Const sFormIdentValue = "ute_ident_value" ' value of field to identify a record to be edited
Const sFormCount = "ute_count" ' number of filters
Const sFormField = "ute_field" ' name of "field" input in filter form
Const sFormCompare = "ute_compare" ' name of "compare" input in filter form
Const sFormValue = "ute_value" ' name of "value" input in filter form
Const sFormCombine = "ute_combine" ' name of "combine" input in filter form
'---------------------------------------------------------------------------
' default values
'
Const DEF_PAGE = 1 ' default page
Const DEF_PAGE_SIZE = 10 ' default number of records per page
Const DEF_SORT_FIELDS = False ' default sort fields alphabetically (columns)
Const DEF_SORT_DIR = "asc" ' default sort direction: SORT_ASC
Const DEF_VIEW_DEFINITIONS = False ' default show field definitions
Const DEF_VIEW_SQL = False ' default show sql statement
Const DEF_PK_DETECTION = True ' default primary key detection
Const DEF_MODE = 1 ' default view mode: MD_TABLE
Const DEF_FORM_MODE = 1 ' default form mode: MD_INSERT
Const DEF_READONLY = False ' default readonly
Const DEF_LIST_TABLES = True ' default list all table in DB
Const DEF_SHOW_DEF_LINK = True ' default show view definitions link
Const DEF_EXPORT_LINK = True ' default export data link
Const DEF_SQL_LINK = True ' default show sql link
Const DEF_FILTERS = True ' default show and activate filters
Const DEF_IMAGE_DIR = "images/" ' directory where the images are
Const DEF_EXPORT_SEP = "," ' seperator chacarter between values
Const DEF_EXPORT_VAL = """" ' chararcter a value is placed into
Const DEF_MAX_INPUT_LENGTH = 58 ' max length of INPUT
Const DEF_MEMO_COLS = 50 ' number of cols of TEXTAREA
Const DEF_MEMO_ROWS = 8 ' number of rows of TEXTAREA
Const DEF_MEMO_COL_WIDTH = 300 ' width of MEMO column in table
Const DEF_NUM_FILTER = 1 ' default number of filters
Const DEF_MAX_FILTER = 10 ' maximum number of filters
Const DEF_MAX_FILTER_LEN = 50 ' max length of filter INPUT
Const DEF_FILTER_SIZE = 30 ' size of filter INPUT
'---------------------------------------------------------------------------
' view modes and form modes
'
Const MD_DATABASE = 0 ' list tables of current database
Const MD_TABLE = 1 ' table view mode
Const MD_FORM = 2 ' form view mode
Const MD_EXPORT = 3 ' export mode
Const MD_FILTER = 4 ' display filter form
Const MD_INSERT = 1 ' insert mode
Const MD_EDIT = 2 ' edit mode
Const MD_DELETE = 3 ' delete mode
'---------------------------------------------------------------------------
' other defines
'
Const SORT_ASC = "asc"
Const SORT_DESC = "desc"
'---------------------------------------------------------------------------
' FileOpen iomode Values
'
Const fsoForReading = 1
Const fsoForWriting = 2
Const fsoForAppending = 8
Const fsoCreateIfNotExist = True
%>
