'**************************************
    ' Name: Common Database Routines
    ' Description:To assist in interfacing w
    '     ith databases. This script can format va
    '     riables and return SQL formats. Such as 
    '     double quoting apposterphies and surroun
    '     ding strings with quotes, Returning NULL
    '     for invalid data types, trimming strings
    '     so they do not exceed maximum lengths. T
    '     his also has some functions so that you 
    '     can open and close databases more convei
    '     ently with just one line of code. You ca
    '     n query a database and get an Array as w
    '     ell with some code.
    ' By: Lewis E. Moten III
    '
    ' Assumes:This script assumes that you a
    '     t least have Microsoft ActiveX Data Obje
    '     cts 2.0 or Higher (ADODB). This script m
    '     ay get some getting used to at first unt
    '     il you go through and study what each ro
    '     utine can do.
    '
    'This code is copyrighted and has    ' limited warranties.Please see http://w
    '     ww.Planet-Source-Code.com/vb/scripts/Sho
    '     wCode.asp?txtCodeId=6270&lngWId=4    'for details.    '**************************************
    
    <!--METADATA Type="TypeLib" NAME="Microsoft ActiveX Data Objects 2.0 Library" UUID="{00000200-0000-0010-8000-00AA006D2EA4}" VERSION="2.0"-->
    <%
    ' Setup the ConnectionString
    Dim sCONNECTION_STRING
    sCONNECTION_STRING = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=D:\inetpub\wwwroot\inc\data\database.mdb;"
    Dim oConn
    '---------------------------------------
    '     ----------------------------------------
    '     
    function DBConnOpen(ByRef aoConnObj)
    	' This routine connects To a database and returns
    	' weather or Not it was successful
    	' Prepare For any errors that may occur While connecting To the database
    	On Error Resume Next
    	' Create a connection object
    	Set aoConnObj = Server.CreateObject("ADODB.Connection")
    	' Open a connection To the database
    	Call aoConnObj.Open(sCONNECTION_STRING)
    	' if any errors have occured
    	if Err Then
    		' Clear errors
    		Err.Clear
    		' Release connection object
    		Set aoConnObj = Nothing
    		' Return unsuccessful results
    		DBConnOpen = False
    	' Else errors did Not occur
    	Else
    		' Return successful results
    		DBConnOpen = True
    	End if ' Err
    End function ' DBConnOpen
    '---------------------------------------
    '     ----------------------------------------
    '     
    Public function DBConnClose(ByRef aoConnObj)
    	' This routine closes the database connection and releases objects
    	' from memory
    	' if the connection variable has been defined as an object
    	if IsObject(aoConnObj) Then
    		' if the connection is open
    		if aoConnObj.State = adStateOpen Then
    			' Close the connection
    			aoConnObj.Close
    			' Return positive Results
    			DBConnClose = True
    		End if ' aoConnObj.State = adStateOpen
    		' Release connection object
    		Set aoConnObj = Nothing
    	End if ' IsObject(aoConnObj)
    End function ' DBConnClose
    '---------------------------------------
    '     ----------------------------------------
    '     
    Public function SetData(ByRef asSQL, ByRef avDataAry)
    	' This routine acquires data from the database
    	Dim loRS ' ADODB.Recordset Object
    	' Create Recordset Object
    	Set loRS = Server.CreateObject("ADODB.Recordset")
    	' Prepare For errors when opening database connection
    	On Error Resume Next
    	' if a connection object has been defined
    	if IsObject(oConn) Then
    		' if the connection is open
    		if oConn.State = adStateOpen Then
    			' Acquire data With connection object
    			Call loRS.Open(asSQL, oConn, adOpenForwardOnly, adLockReadOnly)
    		' Else the connection is closed
    		Else
    			' Set the ConnectionString
    			Call SetConnectionString(csConnectionString)
    			' if atempt To open connection succeeded
    			if DBConnOpen() Then
    				' Acquire data With connection object
    				Call loRS.Open(asSQL, oConn, adOpenForwardOnly, adLockReadOnly)
    				' Return connection object To closed state
    				Call DBConnClose()
    			End if ' DBConnOpen()
    		End if ' aoConn.State = adStateOpen
    	' Else active connection is the ConnectionString
    	Else
    		' Acquire data With ConnectionString
    		Call loRS.Open(asSQL, sCONNECTION_STRING, adOpenForwardOnly, adLockReadOnly)
    	End if ' IsObject(oConn)
    	' if errors occured
    	if Err Then
    		response.write "<HR color=red>" & err.description & "<HR color=red>" & asSQL & "<HR color=red>"
    		' Clear the Error
    		Err.Clear
    		' if the recorset is open
    		if loRS.State = adStateOpen Then
    			' Close the recorset
    			loRS.Close
    		End if ' loRS.State = adStateOpen
    		' Release Recordset from memory
    		Set loRS = Nothing
    		' Return negative results
    		SetData = False
    		' Exit Routine
    		Exit function
    	End if ' Err
    	' Return positve results
    	SetData = True
    	' if data was found
    	if Not loRS.EOF Then
    		' Pull data into an array
    		avDataAry = loRS.GetRows
    	End if ' Not loRS.EOF
    	' Close Recordset
    	loRS.Close
    	' Release object from memory
    	Set loRS = Nothing
    End function ' SetData
    '---------------------------------------
    '     ----------------------------------------
    '     
    ' SQL Preperations are used to prepare v
    '     ariables for SQL Queries. If
    ' invalid data is passed to these routin
    '     es, NULL values or Default Data
    ' is returned to keep your SQL Queries f
    '     rom breaking from users breaking
    ' datatype rules.
    '---------------------------------------
    '     ----------------------------------------
    '     
    Public function SQLPrep_s(ByVal asExpression, ByRef anMaxLength)
    	' if maximum length is defined
    	if anMaxLength > 0 Then
    		' Trim expression To maximum length
    		asExpression = Left(asExpression, anMaxLength)
    	End if ' anMaxLength > 0
    	' Double quote SQL quote characters
    	asExpression = Replace(asExpression, "'", "''")
    	' if Expression is Empty
    	if asExpression = "" Then
    		' Return a NULL value
    		SQLPrep_s = "NULL"
    	' Else expression is Not empty
    	Else
    		' Return quoted expression
    		SQLPrep_s = "'" & asExpression & "'"
    	End if ' asExpression
    End function ' SQLPrep_s
    '---------------------------------------
    '     ----------------------------------------
    '     
    Public function SQLPrep_n(ByVal anExpression)
    	' if expression numeric
    	if IsNumeric(anExpression) And Not anExpression = "" Then
    		' Return number
    		SQLPrep_n = anExpression
    	' Else expression Not numeric
    	Else
    		' Return NULL
    		SQLPrep_n = "NULL"
    	End if ' IsNumeric(anExpression) And Not anExpression = ""
    End function ' SQLPrep_n
    '---------------------------------------
    '     ----------------------------------------
    '     
    Public function SQLPrep_b(ByVal abExpression, ByRef abDefault)
    	' Declare Database Constants
    	Const lbTRUE = -1 '1 = SQL, -1 = Access
    	Const lbFALSE = 0
    	Dim lbResult ' Result To be passed back
    	' Prepare For any errors that may occur
    	On Error Resume Next
    	' if expression Not provided
    	if abExpression = "" Then
    		' Set expression To default value
    		abExpression = abDefault
    	End if ' abExpression = ""
    	' Attempt To convert expression
    	lbResult = CBool(abExpression)
    	' if Err Occured
    	if Err Then
    		' Clear the Error
    		Err.Clear
    		' Determine action based on Expression
    		Select Case LCase(abExpression)
    			' True expressions
    			Case "yes", "on", "true", "-1", "1"
    				lbResult = True
    			' False expressions
    			Case "no", "off", "false", "0"
    				lbResult = False
    			' Unknown expression
    			Case Else
    				lbResult = abDefault
    		End Select ' LCase(abExpression)
    	End if ' Err
    	' if result is True
    	if lbResult Then
    		' Return True
    		SQLPrep_b = lbTRUE
    	' Else Result is False
    	Else
    		' Return False
    		SQLPrep_b = lbFALSE
    	End if ' lbResult
    End function ' SQLPrep_b
    '---------------------------------------
    '     ----------------------------------------
    '     
    Public function SQLPrep_d(ByRef adExpression)
    	' if Expression valid Date
    	if IsDate(adExpression) Then
    		' Return Date
    		'SQLPrep_d = "'" & adExpression & "'" ' SQL Database
    		SQLPrep_d = "#" & adExpression & "#" ' Access Database
    	' Else Expression Not valid Date
    	Else
    		' Return NULL
    		SQLPrep_d = "NULL"
    	End if ' IsDate(adExpression)
    End function ' SQLPrep_d
    '---------------------------------------
    '     ----------------------------------------
    '     
    Public function SQLPrep_c(ByVal acExpression)
    	' if Empty Expression
    	if acExpression = "" Then
    		' Return Null
    		SQLPrep_c = "NULL"
    	' Else expression has content
    	Else
    		' Prepare For Errors
    		On Error Resume Next
    		' Attempt To convert expression to Currency
    		SQLPRep_c = CCur(acExpression)
    		' if Error occured
    		if Err Then
    			' Clear Error
    			Err.Clear
    			SQLPrep_c = "NULL"
    		End if ' Err
    	End if ' acExpression = ""
    End function ' SQLPrep_c
    '---------------------------------------
    '     ----------------------------------------
    '     
    function buildJoinStatment(sTable,sFldLstAry,rs,conn)
    Dim i,sSql,sTablesAry,sJnFldsAry,bJoinAry,sJoinDisplay
    ReDim sTablesAry(UBound(sFldLstAry))
    ReDim sJnFldsAry(UBound(sFldLstAry))
    ReDim bJoinAry(UBound(sFldLstAry))
    For i = 0 To UBound(sFldLstAry)
    sSql = "SELECT OBJECT_NAME(rkeyid),COL_NAME(rkeyid,rkey1)"
    sSql = sSql &" FROM sysreferences"
    sSql = sSql &" WHERE fkeyid = OBJECT_ID('"& sTable &"') "
    sSql = sSql &" AND col_name(fkeyid,fkey1) = '"& Trim(sFldLstAry(i)) &"'"
    rs.open sSql,conn
    if Not rs.eof Then
    sTablesAry(i) = rs(0)
    sJnFldsAry(i) = rs(1)
    End if
    rs.close
    Next
    if UBound(sFldLstAry) >= 0 Then
    For i = 0 To UBound(sFldLstAry)
    if sTablesAry(i) <> "" Then
    bJoinAry(i) = True
    Else
    bJoinAry(i) = False
    End if
    if i <> UBound(sFldLstAry) Then sSql = sSql &" +' - '+ "
    Next
    sSql = "FROM "& sTable
    For i = 0 To UBound(sFldLstAry)
    if bJoinAry(i) Then sSql = sSql &" LEFT JOIN "& sTablesAry(i) &" ON "& sTable &"."& sFldLstAry(i) &" = "& sTablesAry(i) &"."& sJnFldsAry(i)
    Next
    End if
    buildJoinStatment = sSql
    End function
    '---------------------------------------
    '     ----------------------------------------
    '     
    function buildQuery(ByRef asFieldAry, ByVal asKeyWords)
    	' To find fields that may have a word in them
    	' OR roger
    	' | roger
    	' roger
    	' To find fields that must match a word
    	' AND roger
    	' + roger
    	' & roger
    	' To find fields that must Not match a word
    	' Not roger
    	' - roger
    	' Also use phrases
    	' +"rogers dog" -cat
    	' +(rogers dog)
    	Dim loRegExp
    	Dim loRequiredWords
    	Dim loUnwantedWords
    	Dim loOptionalWords
    	Dim lsSQL
    	Dim lnIndex
    	Dim lsKeyword
    	Set loRegExp = New RegExp
    	loRegExp.Global = True
    	loRegExp.IgnoreCase = True
    	loRegExp.Pattern = "((AND|[+&])\s*[\(\[\{""].*[\)\]\}""])|((AND\s|[+&])\s*\b[-\w']+\b)"
    	Set loRequiredWords = loRegExp.Execute(asKeywords)
    	asKeywords = loRegExp.Replace(asKeywords, "")
    	loRegExp.Pattern = "(((NOT|[-])\s*)?[\(\[\{""].*[\)\]\}""])|(((NOT\s+|[-])\s*)\b[-\w']+\b)"
    	Set loUnwantedWords = loRegExp.Execute(asKeywords)
    	asKeywords = loRegExp.Replace(asKeywords, "")
    	loRegExp.Pattern = "(((OR|[|])\s*)?[\(\[\{""].*[\)\]\}""])|(((OR\s+|[|])\s*)?\b[-\w']+\b)"
    	Set loOptionalWords = loRegExp.Execute(asKeywords)
    	asKeywords = loRegExp.Replace(asKeywords, "")
    	if Not loRequiredWords.Count = 0 Then
    		' REQUIRED
    		lsSQL = lsSQL & "("
    		For lnIndex = 0 To loRequiredWords.Count - 1
    			lsKeyword = loRequiredWords.Item(lnIndex).Value
    			loRegExp.Pattern = "^(AND|[+&])\s*"
    			lsKeyword = loRegExp.Replace(lsKeyword, "")
    			loRegExp.Pattern = "[()""\[\]{}]"
    			lsKeyword = loRegExp.Replace(lsKeyword, "")
    			lsKeyword = Replace(lsKeyword, "'", "''")
    			if Not lnIndex = 0 Then
    				lsSQL = lsSQL & " AND "
    		 	End if
    			lsSQL = lsSQL & "(" & Join(asFieldAry, " LIKE '%" & lsKeyword & "%' OR ") & " LIKE '%" & lsKeyword & "%')"
    		Next
    		lsSQL = lsSQL & ")"
    	End if
    	if Not loOptionalWords.Count = 0 Then
    		' OPTIONAL
    		if lsSQL = "" Then
    			lsSQL = lsSQL & "("
    		Else
    			lsSQL = lsSQL & " AND ("
    		End if
    		For lnIndex = 0 To loOptionalWords.Count - 1
    			lsKeyword = loOptionalWords.Item(lnIndex).Value
    			loRegExp.Pattern = "^(OR|[|])\s*"
    			lsKeyword = loRegExp.Replace(lsKeyword, "")
    			loRegExp.Pattern = "[()""\[\]{}]"
    			lsKeyword = loRegExp.Replace(lsKeyword, "")
    			lsKeyword = Replace(lsKeyword, "'", "''")
    			if Not lnIndex = 0 Then
    				lsSQL = lsSQL & " OR "
    			End if
    			lsSQL = lsSQL & "(" & Join(asFieldAry, " LIKE '%" & lsKeyword & "%' OR ") & " LIKE '%" & lsKeyword & "%')"
    		Next
    		lsSQL = lsSQL & ")"
    	End if
    	if Not loUnwantedWords.Count = 0 Then
    		' UNWANTED
    		if lsSQL = "" Then
    			lsSQL = lsSQL & "NOT ("
    		Else
    			lsSQL = lsSQL & " AND Not ("
    		End if
    		For lnIndex = 0 To loUnwantedWords.Count - 1
    			lsKeyword = loUnWantedWords.Item(lnIndex).Value
    			loRegExp.Pattern = "^(NOT|[-])\s*"
    			lsKeyword = loRegExp.Replace(lsKeyword, "")
    			loRegExp.Pattern = "[()""\[\]{}]"
    			lsKeyword = loRegExp.Replace(lsKeyword, "")
    			lsKeyword = Replace(lsKeyword, "'", "''")
    			if Not lnIndex = 0 Then
    				lsSQL = lsSQL & " OR "
    			End if
    			lsSQL = lsSQL & "(" & Join(asFieldAry, " LIKE '%" & lsKeyword & "%' OR ") & " LIKE '%" & lsKeyword & "%')"
    		Next
    		lsSQL = lsSQL & ")"
    	End if
    	if Not lsSQL = "" Then lsSQL = "(" & lsSQL & ")"
    	buildQuery = lsSQL
    End function
    '---------------------------------------
    '     ----------------------------------------
    '     
    %>