Common Database Routines

Common Database Routines

--------------------------------------------------------------------------------

Description : To assist in interfacing with databases. This script can format variables and return SQL formats. Such as double quoting apposterphies and surrounding strings with quotes, Returning NULL for invalid data types, trimming strings so they do not exceed maximum lengths. This also has some functions so that you can open and close databases more conveiently with just one line of code. You can query a database and get an Array as well with some code.


<%
' Setup the ConnectionString
Dim sCONNECTION_STRING
sCONNECTION_STRING = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=D:inetpubwwwrootincdatadatabase.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*[([{""].*[)]}""])|((ANDs|[+&])s* [-w']+ )"
Set loRequiredWords = loRegExp.Execute(asKeywords)
asKeywords = loRegExp.Replace(asKeywords, "")
loRegExp.Pattern = "(((NOT|[-])s*)?[([{""].*[)]}""])|(((NOTs+|[-])s*) [-w']+ )"
Set loUnwantedWords = loRegExp.Execute(asKeywords)
asKeywords = loRegExp.Replace(asKeywords, "")
loRegExp.Pattern = "(((OR|[|])s*)?[([{""].*[)]}""])|(((ORs+|[|])s*)? [-w']+ )"
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