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.


  
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!



 '**************************************
 ' for :Common Database Routines
 '**************************************
 Copyright (c) 1999 by Lewis Moten, All rights reserved.


code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!



 '**************************************
 ' 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 Moten
 '
 '
 ' Inputs:None
 '
 ' Returns:None
 '
 'Assumes:This script assumes that you at
 '  least have Microsoft ActiveX Data Object
 '  s 2.0 or Higher (ADODB). This script may
 '  get some getting used to at first until
 '  you go through and study what each routi
 '  ne can do.
 '
 'Side Effects:None
 '
 'Warranty:
 'code provided by Planet Source Code(tm)
 '  (www.Planet-Source-Code.com) 'as is', wi
 '  thout warranties as to performance, fitn
 '  ess, merchantability,and any other warra
 '  nty (whether expressed or implied).
 'Terms of Agreement:
 'By using this source code, you agree to
 '  the following terms...
 ' 1) You may use this source code in per
 '  sonal projects and may compile it into a
 '  n .exe/.dll/.ocx and distribute it in bi
 '  nary format freely and with no charge.
 ' 2) You MAY NOT redistribute this sourc
 '  e code (for example to a web site) witho
 '  ut written permission from the original
 '  author.Failure to do so is a violation o
 '  f copyright laws.
 ' 3) You may link to this code from anot
 '  her website, provided it is not wrapped
 '  in a frame.
 ' 4) The author of this code may have re
 '  tained certain additional copyright righ
 '  ts.If so, this is indicated in the autho
 '  r's description.
 '**************************************
 
 <!--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
 '---------------------------------------
 '  ----------------------------------------
 '  
 %>