<![CDATA[
<%'Version: 02/22/2000
Dim intRecID 'Value of the key field for the current record. This variable is declared
'outside of the script to make it available to the SQLProcess calling script.
'This allows for a SELECT statement to follow to return a newly created
'or updated record.
Function SQLProcess(strQuery)
Dim act 'User action: Search, Update, Add, or Delete.
Dim SQLpredicate 'Contains the predicate of the SQL statement.
Dim strTable 'Database table indicated by the "-tableName" input.
Dim strFieldList 'List of table fields used in an INSERT statement.
Dim strValueList 'List of field values used in an INSERT statement.
Dim strIDField 'Name of the numerical key field in the table.
Dim objPairs 'Dictionary object to contain name/value pairs from query string.
Dim objTypes 'Dictionay object to contain data types of the table fields.
Dim arrKeys 'Array of field names from "objPairs".
Dim arrItems 'Array of field values from "objPairs".
Dim strThisKey 'Current dictionary key used when building SQL predicate.
Dim strThisItem 'Current dictionary item used when building SQL predicate.
Dim intLoop 'Track interation through "objPairs" dictionary.
Dim intItemLoopCount 'Track iteration through array created when multiple values
'are submitted for a single field.
Dim i 'Loop counter.
Dim blnBegArray 'Marks beginning of array of multiple field values.
Dim blnEndArray 'Marks end of array of multiple field values.
Dim strNewItem 'Used for string manipulation of field values in building SQL predicate.
Dim SQLsegment 'Used in building SQL predicates.
Dim strParen 'Holds value of parenthesis when indicated by "-paren" form tag.
Dim strOp 'Value indicated by the "-op" form tag.
Dim strOperator 'Value passed from "strOp" variable.
Dim blnOpUse 'Determines when non-default "strOperator" value is returned to default value.
Dim strLogOp 'Value indicated by the "-logOp" form tag.
Dim strLogOperator 'Value passed from "strLogOp" variable.
Dim blnLogOpUse 'Determines when non-default "strLogOperator" value is returned to default value.
Dim postLogOp 'Value indicated by the "-postLogOp" form tag.
Dim postLogOperator 'Value passed from "postLogOp variable.
Dim blnPostLogOpUse 'Determines when non-default "postLogOperator" value is returned to default value.
SQLpredicate = "" 'Set these variables to
strFieldList = "" 'empty strings. They are used to
strValueList = "" 'build SQL predicates.
strIDField = ""
intRecID = 0
'Create a dictionary object and add the name/value pairs submitted from the form.
Set objPairs = splitPairs(strQuery)
act = objPairs.Item("btn") 'Which button (action) was selected.
objPairs.Remove("btn") 'Remove this key/value pair from the Dictionary Object.
strTable = objPairs.Item("-tableName") 'Which database table is specified.
objPairs.Remove("-tableName") 'Remove this key/value pair from the Dictionary Object.
arrKeys = objPairs.Keys 'Array of keys
arrItems = objPairs.Items 'Array of items
Set objTypes = dataTypes(strTable) 'Get data types of fields in the current table.
'Loop through name/value dictionary and assemble segments of the SQL statement.
For intLoop = 0 To objPairs.Count - 1
strThisKey = arrKeys(intLoop) 'Key name.
strThisItem = arrItems(intLoop) 'Field value.
If act = "Update" Then
If Len(strThisItem) = 0 Then strThisItem = "Null" 'Allow existing field value to be
'removed.
ElseIf Left(strThisKey, 4) = "-add" Then 'Allows default values to be specified
'on an add/search form for adding to new records
'while excluding the values from a search.
If act = "Add" Then
strThisKey = Right(strThisKey, Len(strThisKey) - 4)
Else
strThisItem = ""
End If
End If
If Left(strThisKey, 3) = "-op" Then 'Sets a variable for the Logical strOp.
strOp = strThisItem
blnOpUse = True
ElseIf Left(strThisKey, 6) = "-logOp" Then 'Sets a variable for the Logical strOp.
strLogOp = strThisItem
blnLogOpUse = True
ElseIf Left(strThisKey, 10) = "-postLogOp" Then 'Sets a variable for the
postLogOp = strThisItem 'Logical strOp following a mulit-value field.
blnPostLogOpUse = True
ElseIf Left(strThisKey, 6) = "-paren" Then 'Set a variable with open or close parenthesis.
strParen = strThisItem
ElseIf Left(strThisKey, 3) = "-id" Then 'Get the record ID if submitted.
intRecID = strThisItem
strIDField = Right(strThisKey, Len(strThisKey) - 3)
If act = "Add" Then intRecID = nextID(strIDField, strTable) 'Returns next record number.
'If the key doesn't identify the dictionary entry as one of the predefined hidden input tags
'then the entry is a field name/value pair included in the SQL statement.
ElseIf Len(strThisItem) > 0 Then
'For multiple values submitted for a single field, the "-mltiFld" flag is removed
'and values are separated for individual use in a SELECT statement. For INSERT and
'UPDATE statements, multiple values are posted to the data source as a single string
'with values separated by a comma. A comma is left at the beginning and end of the string
'to enable searching the field for individual values. When a SELECT statement is created
'to search for a single value in a field with multiple values, the search value is
'preceeded and followed with a comma. A value of "1" submitted from a form to search a
'multiple value field would cause the SQL statement generated to search for ",1,". This
'allows multiple values to be posted to a field and then a single value to be searched
'within the field without returning values for which the searched value is a subset.
If Left(strThisItem, 9) = "-mltiFld," Then
strThisItem = Right(strThisItem, Len(strThisItem)-8)
If act = "Search" Then
If InStr(strThisItem, ",") Then
strThisItem = Mid(strThisItem, 2, Len(strThisItem) - 2)
End If
strThisItem = Split(strThisItem, ",")
End If
End If
'If the current dictionary item (field value) is a multiple value split into
'an array for searching, get the number of values in the array.
If IsArray(strThisItem) Then
intItemLoopCount = Ubound(strThisItem)
Else
intItemLoopCount = 0
End If
For i = 0 to intItemLoopCount 'Iterate through array if it exists.
If IsArray(strThisItem) Then
strNewItem = "," & strThisItem(i) & "," 'Array variable.
Else
strNewItem = strThisItem 'Non-array variable.
End If
If act = "Search" Then
'The next two If statements mark the beginning and end of a multiple value entry
'for a single field. This allows the script to place parens around the statement.
If IsArray(strThisItem) and i = 0 Then
blnBegArray = True
Else
blnBegArray = False
End If
If IsArray(strThisItem) and i = intItemLoopCount Then
blnEndArray = True
Else
blnEndArray = False
End If
'Determine logical operator to follow the current name/value pair.
If strLogOp = "or" Then
strLogOperator = " OR "
Else
strLogOperator = " AND "
End If
'Determine logical operator to follow a mulit-value field.
If postLogOp = "or" Then
postLogOperator = " OR "
Else
postLogOperator = " AND "
End If
Select Case strOp 'Comparison operator for name/value pair.
Case "ne" 'not equal
strOperator = " <> "
Case "bw" 'begins with
strOperator = " LIKE "
strNewItem = strNewItem & "%"
Case "ew" 'ends with
strOperator = " LIKE "
strNewItem = "%" & strNewItem
Case "cn" 'contains
strOperator = " LIKE "
strNewItem = "%" & strNewItem & "%"
Case "lt" 'less than
strOperator = " < "
Case "le" 'less than or equal to
strOperator = " <= "
Case "gt" 'greater than
strOperator = " > "
Case "ge" 'greater than or equal to
strOperator = " >= "
Case Else 'equal
strOperator = " = "
End Select
End If
'This case statement checks the dictionary object created earlier to contain the
'field data types to determine if single quotes or hash marks are needed to
'to surround the field value.
Select Case objTypes(strThisKey)
Case adBSTR, adChar, adLongVarChar, adLongVarWChar, adVarChar, adVarWChar, _
adWChar
'Add single quotes around string values and remove single quotes
'from within the string.
If strNewItem <> "Null" Then strNewItem = "'" _
& replace(strNewItem, "'", "''") & "'"
Case adDate, adDBDate, adDBFileTime, adDBTime, adDBTime, adDBTimeStamp
'Add Hash Marks around dates/times.
If strNewItem <> "Null" Then strNewItem = "#" & strNewItem & "#"
End Select
'Build SQL predicate based on action requested.
Select Case act
Case "Search"
'Assemble each field/operator/value/logical operator segment.
SQLsegment = strThisKey & strOperator & strNewItem
'Place an opening paren if one is specified or if beginning a
'multiple value segment.
If strParen = Chr(40) or blnBegArray Then
SQLpredicate = SQLpredicate & "(" & SQLsegment
'Place closing paren if a single value is submitted
'where multiple values are an option.
If blnEndArray Then
SQLpredicate = SQLpredicate & ")" & postLogOperator
Else
SQLpredicate = SQLpredicate & strLogOperator
End If
strParen = Null
'Place a closing paren if one is specified or if ending a
'multiple value segment.
ElseIf strParen = Chr(41) or blnEndArray Then
SQLpredicate = SQLpredicate & SQLsegment & ")" & postLogOperator
Else
SQLpredicate = SQLpredicate & SQLsegment & strLogOperator
End If
strParen = Null
Case "Update"
SQLsegment = strThisKey & " = " & strNewItem
SQLpredicate = SQLpredicate & SQLsegment & ", "
Case "Add"
'List of field names for INSERT statement.
strFieldList = strFieldList & strThisKey & ", "
'List of values for INSERT statement.
strValueList = strValueList & strNewItem & ", "
End Select
'If non-default operators are specified, the following variables are set to true.
'After the operator is applied to the subsequent SQL segment, these variables indicate
'that the operator variables are set to null at the end of the current iteration. In
'following iteration, the operator variables return to default values.
blnOpUse = False
blnLogOpUse = False
blnPostLogOpUse = False
Next
End If
If blnOpUse = False Then strOp = Null
If blnLogOpUse = False Then strLogOp = Null
If blnPostLogOpUse = False Then postLogOp = Null
Next
Set objPairs = Nothing
Set objTypes = Nothing
'Create final SQL statement.
strSQL = createSQL(act, SQLpredicate, strTable, strFieldList, strValueList, strIDField, intRecID)
SQLProcess = strSQL
End Function
'<-------------------------------------------------------------------------->
'** The splitPairs() function separates all of the name/value pairs in the **
'** query string and puts them into a dictionary object with field names **
'** as the keys and values as the items. **
Function splitPairs(strQuery)
Dim objResult 'The dictionary object.
Dim intSep 'Identifies the position of the ampersand between pairs.
Dim strKey 'Holds the field name to add to the "keys" collection.
Dim strItem 'Holds the field value to add to the "items" collection.
Dim strNVPair 'Holds the initial name/value separated from the query string.
Dim intEqu 'Identifies the position of the equal sign in each name/value pair.
Dim intKeyCount 'Incremented number to uniquely identify certain hidden input parameters.
Dim strOpFlag 'Holds operator key values until the corresponding field is verified to contain data.
Dim arrOpFlag 'Array of strOpFlag values used to remove dictionary entries.
Dim addItem 'Used in building multiple field value strings.
Dim i 'Loop counter.
intKeyCount = 1
Set objResult = CreateObject("Scripting.Dictionary") 'Dictionary object to hold results.
intSep = Instr(strQuery, "&") 'Segment the query string into name/value pairs.
Do While intSep
strKey = ""
strItem = ""
strNVPair = Left(strQuery, intSep - 1) 'Retrieve the first pair in the string.
strQuery = Mid(strQuery, intSep + 1) 'Set the string to the remaining pairs.
intEqu = Instr(strNVPair, "=") 'Separate name/value pair.
If intEqu > 1 Then strKey = URLDecode(Left(strNVPair, intEqu - 1)) 'Name
If intEqu < Len(strNVPair) Then strItem = URLDecode(Mid(strNVPair, intEqu + 1)) 'Value
Select Case strKey
'If the key is one of these case values a number is appended to the key. This
'prevents multiple occurances of the same key, which would create an error, where
'the same tag is used more than once on a form.
Case "-op", "-logOp", "-postLogOp", "-paren"
strKey = strKey & intKeyCount
intKeyCount = intKeyCount + 1
If IsNull(strOpFlag) Then
strOpFlag = strKey
Else
strOpFlag = strOpFlag & "," & strKey
End If
Case Else
'If a dictionary entry is made for one of the case values and the subsequent field
'has no data entered, then the dictionary entry is removed. This prevents an operator
'specified for certain field from being carried over to the next field containing
'submitted data.
If Len(strItem) = 0 And Not IsNull(strOpFlag) Then
arrOpFlag = Split(strOpFlag, ",")
For i = 0 To UBound(arrOpFlag)
objResult.Remove(arrOpFlag(i))
Next
End If
strOpFlag = Null
End Select
If objResult.Exists(strKey) Then
'This section determines if more than one value has been submitted for the same field.
'If so, the value is appended to the existing dictionary item. Otherwise, the new
'entry is added to the dictionary.
addItem = objResult.Item(strKey)
If Left(addItem, 8) = "-mltiFld" Then 'Text string added to flag a multi-value item
addItem = addItem & "," & strItem
Else
addItem = "-mltiFld," & addItem & "," & strItem
End If
objResult.Item(strKey) = addItem 'Update the existing item.
Else
objResult.Add strKey, strItem 'Add the pair to the dictionary.
End If
intSep = Instr(strQuery, "&")
Loop
'This last part handles the last name/value pair.
strKey = ""
strItem = ""
intEqu = Instr(strQuery, "=")
If intEqu > 1 Then strKey = URLDecode(Left(strQuery, intEqu - 1))
If intEqu < Len(strQuery) Then strItem = URLDecode(Mid(strQuery, intEqu + 1))
objResult.Add strKey, strItem
Set splitPairs = objResult
Set objResult = Nothing
End Function
'<-------------------------------------------------------------------------->
'** This function decodes any URLEncoded portion of the query string. **
'** This function is taken from Wrox Press: Activer Server Pages 2.0. **
Function URLDecode(strToDecode)
Dim strIn 'The function input string to decode.
Dim strOut 'Output string.
Dim intPos 'Determines positions of "+" & "%" in the input string.
Dim strLeft 'Used in manipulating the string.
Dim strRight 'Used in manipulating the string.
strIn = strToDecode
strOut = ""
intPos = Instr(strIn, "+")
Do While intPos
strLeft = ""
strRight = ""
If intPos > 1 Then strLeft = Left(strIn, intPos - 1)
If intPos < Len(strIn) Then strRight = Mid(strIn, intPos + 1)
strIn = strLeft & " " & strRight
intPos = Instr(strIn, "+")
Loop
intPos = Instr(strIn, "%")
Do While intPos
If intPos > 1 Then strOut = strOut & left(strIn, intPos - 1)
strOut = strOut & Chr(CInt("&H" & Mid(strIn, intPos + 1, 2)))
If intPos > (Len(strIn) - 3) Then
strIn = ""
Else
strIn = Mid(strIn, intPos + 3)
End If
intPos = Instr(strIn, "%")
Loop
URLDecode = strOut & strIn
End Function
'<-------------------------------------------------------------------------->
'** This function looks up the data types of the fields to be use in the **
'** SQL statement. **
Function dataTypes(strTableName)
Dim objDataTypes 'Dictionary object to hold field names and data types.
Dim objTable 'Schema object for retrieving field data types.
Dim strTblKey 'Field name.
Dim strTblItem 'Data type.
Set objDataTypes = CreateObject("Scripting.Dictionary")
Set objTable = conn.OpenSchema(adSchemaColumns)
objTable.Filter = "TABLE_NAME = '" & strTableName & "'"
While Not objTable.EOF 'Add field names & datatypes to the dictionary.
strTblKey = objTable("COLUMN_NAME")
strTblItem = objTable("DATA_TYPE")
objDataTypes.Add strTblKey, strTblItem
objTable.MoveNext
Wend
set dataTypes = objDataTypes
set objDataTypes = Nothing
End Function
'<-------------------------------------------------------------------------->
'** This function looks up the max entry in the key field and returns the **
'** next incremental number for adding new records. **
Function nextID(idFieldName, strTableName)
Dim strSQL
Dim rs
Dim intNewID
strSQL = "SELECT MAX(" & idFieldName & ") FROM " & strTableName
Set rs = conn.Execute(strSQL)
If Not rs.EOF Then intNewID = rs(0)
If IsNull(intNewID) Then intNewID = 0
intNewID = intNewID + 1
rs.Close
Set rs = Nothing
nextID = intNewID
End Function
'<-------------------------------------------------------------------------->
'** The createSQL() function builds the final SQL string output based on **
'** the user action and form inputs. **
Function createSQL(action, strPredicate, strTableName, strFields, strValues, idFieldName, intRecordID)
Select Case action
Case "Search"
If Right(strPredicate, 4) = "AND " Then
strPredicate = Left(strPredicate, Len(strPredicate) - 5)
Else
strPredicate = Left(strPredicate, Len(strPredicate) - 4)
End If
strSQL = "SELECT * FROM " & strTableName & " WHERE " & strPredicate
Case "Update"
strPredicate = Left(strPredicate, Len(strPredicate) - 2)
strSQL = "UPDATE " & strTableName & " SET " & strPredicate & " WHERE " _
& idFieldName & " = " & intRecordID
Case "Add"
strFields = Left(strFields, Len(strFields) - 2)
strValues = Left(strValues, Len(strValues) - 2)
strSQL = "INSERT INTO " & strTableName _
& " (" & idFieldName & ", " & strFields & ") VALUES (" _
& intRecordID & ", " & strValues & ")"
Case "Delete"
strSQL = "DELETE FROM " & strTableName & " WHERE " & idFieldName & " = " & intRecID
End Select
createSQL = strSQL
End Function
%>
]]>