<%'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 %>