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.
'**************************************
1
2' Setup the ConnectionString
3Dim sCONNECTION_STRING
4sCONNECTION_STRING = "DRIVER=Microsoft Access Driver
5(*.mdb);DBQ=D:\inetpub\wwwroot\inc\data\database.mdb;"
6Dim oConn
7'---------------------------------------
8' ----------------------------------------
9'
10Function DBConnOpen(ByRef aoConnObj)
11' This routine connects To a database and returns
12' weather or Not it was successful
13' Prepare For any errors that may occur While connecting To the database
14On Error Resume Next
15' Create a connection object
16Set aoConnObj = Server.CreateObject("ADODB.Connection")
17' Open a connection To the database
18Call aoConnObj.Open(sCONNECTION_STRING)
19' If any errors have occured
20If Err Then
21' Clear errors
22Err.Clear
23' Release connection object
24Set aoConnObj = Nothing
25' Return unsuccessful results
26DBConnOpen = False
27' Else errors did Not occur
28Else
29' Return successful results
30DBConnOpen = True
31End If ' Err
32End Function ' DBConnOpen
33'---------------------------------------
34' ----------------------------------------
35'
36Public Function DBConnClose(ByRef aoConnObj)
37' This routine closes the database connection and releases objects
38' from memory
39' If the connection variable has been defined as an object
40If IsObject(aoConnObj) Then
41' If the connection is open
42If aoConnObj.State = adStateOpen Then
43' Close the connection
44aoConnObj.Close
45' Return positive Results
46DBConnClose = True
47End If ' aoConnObj.State = adStateOpen
48' Release connection object
49Set aoConnObj = Nothing
50End If ' IsObject(aoConnObj)
51End Function ' DBConnClose
52'---------------------------------------
53' ----------------------------------------
54'
55Public Function SetData(ByRef asSQL, ByRef avDataAry)
56' This routine acquires data from the database
57Dim loRS ' ADODB.Recordset Object
58' Create Recordset Object
59Set loRS = Server.CreateObject("ADODB.Recordset")
60' Prepare For errors when opening database connection
61On Error Resume Next
62' If a connection object has been defined
63If IsObject(oConn) Then
64' If the connection is open
65If oConn.State = adStateOpen Then
66' Acquire data With connection object
67Call loRS.Open(asSQL, oConn, adOpenForwardOnly, adLockReadOnly)
68' Else the connection is closed
69Else
70' Set the ConnectionString
71Call SetConnectionString(csConnectionString)
72' If atempt To open connection succeeded
73If DBConnOpen() Then
74' Acquire data With connection object
75Call loRS.Open(asSQL, oConn, adOpenForwardOnly, adLockReadOnly)
76' Return connection object To closed state
77Call DBConnClose()
78End If ' DBConnOpen()
79End If ' aoConn.State = adStateOpen
80' Else active connection is the ConnectionString
81Else
82' Acquire data With ConnectionString
83Call loRS.Open(asSQL, sCONNECTION_STRING, adOpenForwardOnly, adLockReadOnly)
84End If ' IsObject(oConn)
85' If errors occured
86If Err Then
87response.write "
<hr color="red"/>
1" & err.description & "
<hr color="red"/>
1" & asSQL & "
<hr color="red"/>
1"
2' Clear the Error
3Err.Clear
4' If the recorset is open
5If loRS.State = adStateOpen Then
6' Close the recorset
7loRS.Close
8End If ' loRS.State = adStateOpen
9' Release Recordset from memory
10Set loRS = Nothing
11' Return negative results
12SetData = False
13' Exit Routine
14Exit Function
15End If ' Err
16' Return positve results
17SetData = True
18' If data was found
19If Not loRS.EOF Then
20' Pull data into an array
21avDataAry = loRS.GetRows
22End If ' Not loRS.EOF
23' Close Recordset
24loRS.Close
25' Release object from memory
26Set loRS = Nothing
27End Function ' SetData
28'---------------------------------------
29' ----------------------------------------
30'
31' SQL Preperations are used to prepare v
32' ariables for SQL Queries. If
33' invalid data is passed to these routin
34' es, NULL values or Default Data
35' is returned to keep your SQL Queries f
36' rom breaking from users breaking
37' datatype rules.
38'---------------------------------------
39' ----------------------------------------
40'
41Public Function SQLPrep_s(ByVal asExpression, ByRef anMaxLength)
42' If maximum length is defined
43If anMaxLength > 0 Then
44' Trim expression To maximum length
45asExpression = Left(asExpression, anMaxLength)
46End If ' anMaxLength > 0
47' Double quote SQL quote characters
48asExpression = Replace(asExpression, "'", "''")
49' If Expression is Empty
50If asExpression = "" Then
51' Return a NULL value
52SQLPrep_s = "NULL"
53' Else expression is Not empty
54Else
55' Return quoted expression
56SQLPrep_s = "'" & asExpression & "'"
57End If ' asExpression
58End Function ' SQLPrep_s
59'---------------------------------------
60' ----------------------------------------
61'
62Public Function SQLPrep_n(ByVal anExpression)
63' If expression numeric
64If IsNumeric(anExpression) And Not anExpression = "" Then
65' Return number
66SQLPrep_n = anExpression
67' Else expression Not numeric
68Else
69' Return NULL
70SQLPrep_n = "NULL"
71End If ' IsNumeric(anExpression) And Not anExpression = ""
72End Function ' SQLPrep_n
73'---------------------------------------
74' ----------------------------------------
75'
76Public Function SQLPrep_b(ByVal abExpression, ByRef abDefault)
77' Declare Database Constants
78Const lbTRUE = -1 '1 = SQL, -1 = Access
79Const lbFALSE = 0
80Dim lbResult ' Result To be passed back
81' Prepare For any errors that may occur
82On Error Resume Next
83' If expression Not provided
84If abExpression = "" Then
85' Set expression To default value
86abExpression = abDefault
87End If ' abExpression = ""
88' Attempt To convert expression
89lbResult = CBool(abExpression)
90' If Err Occured
91If Err Then
92' Clear the Error
93Err.Clear
94' Determine action based on Expression
95Select Case LCase(abExpression)
96' True expressions
97Case "yes", "on", "true", "-1", "1"
98lbResult = True
99' False expressions
100Case "no", "off", "false", "0"
101lbResult = False
102' Unknown expression
103Case Else
104lbResult = abDefault
105End Select ' LCase(abExpression)
106End If ' Err
107' If result is True
108If lbResult Then
109' Return True
110SQLPrep_b = lbTRUE
111' Else Result is False
112Else
113' Return False
114SQLPrep_b = lbFALSE
115End If ' lbResult
116End Function ' SQLPrep_b
117'---------------------------------------
118' ----------------------------------------
119'
120Public Function SQLPrep_d(ByRef adExpression)
121' If Expression valid Date
122If IsDate(adExpression) Then
123' Return Date
124'SQLPrep_d = "'" & adExpression & "'" ' SQL Database
125SQLPrep_d = "#" & adExpression & "#" ' Access Database
126' Else Expression Not valid Date
127Else
128' Return NULL
129SQLPrep_d = "NULL"
130End If ' IsDate(adExpression)
131End Function ' SQLPrep_d
132'---------------------------------------
133' ----------------------------------------
134'
135Public Function SQLPrep_c(ByVal acExpression)
136' If Empty Expression
137If acExpression = "" Then
138' Return Null
139SQLPrep_c = "NULL"
140' Else expression has content
141Else
142' Prepare For Errors
143On Error Resume Next
144' Attempt To convert expression to Currency
145SQLPRep_c = CCur(acExpression)
146' If Error occured
147If Err Then
148' Clear Error
149Err.Clear
150SQLPrep_c = "NULL"
151End If ' Err
152End If ' acExpression = ""
153End Function ' SQLPrep_c
154'---------------------------------------
155' ----------------------------------------
156'
157Function buildJoinStatment(sTable,sFldLstAry,rs,conn)
158Dim i,sSql,sTablesAry,sJnFldsAry,bJoinAry,sJoinDisplay
159ReDim sTablesAry(UBound(sFldLstAry))
160ReDim sJnFldsAry(UBound(sFldLstAry))
161ReDim bJoinAry(UBound(sFldLstAry))
162For i = 0 To UBound(sFldLstAry)
163sSql = "SELECT OBJECT_NAME(rkeyid),COL_NAME(rkeyid,rkey1)"
164sSql = sSql &" FROM sysreferences"
165sSql = sSql &" WHERE fkeyid = OBJECT_ID('"& sTable &"') "
166sSql = sSql &" AND col_name(fkeyid,fkey1) = '"& Trim(sFldLstAry(i)) &"'"
167rs.open sSql,conn
168If Not rs.eof Then
169sTablesAry(i) = rs(0)
170sJnFldsAry(i) = rs(1)
171End If
172rs.close
173Next
174If UBound(sFldLstAry) >= 0 Then
175For i = 0 To UBound(sFldLstAry)
176If sTablesAry(i) <> "" Then
177bJoinAry(i) = True
178Else
179bJoinAry(i) = False
180End If
181If i <> UBound(sFldLstAry) Then sSql = sSql &" +' - '+ "
182Next
183sSql = "FROM "& sTable
184For i = 0 To UBound(sFldLstAry)
185If bJoinAry(i) Then sSql = sSql &" LEFT JOIN "& sTablesAry(i) &" ON "& sTable &"."& sFldLstAry(i) &"
186= "& sTablesAry(i) &"."& sJnFldsAry(i)
187Next
188End If
189buildJoinStatment = sSql
190End Function
191'---------------------------------------
192' ----------------------------------------
193'
194Function buildQuery(ByRef asFieldAry, ByVal asKeyWords)
195' To find fields that may have a word in them
196' OR roger
197' | roger
198' roger
199' To find fields that must match a word
200' AND roger
201' + roger
202' & roger
203' To find fields that must Not match a word
204' Not roger
205' - roger
206' Also use phrases
207' +"rogers dog" -cat
208' +(rogers dog)
209Dim loRegExp
210Dim loRequiredWords
211Dim loUnwantedWords
212Dim loOptionalWords
213Dim lsSQL
214Dim lnIndex
215Dim lsKeyword
216Set loRegExp = New RegExp
217loRegExp.Global = True
218loRegExp.IgnoreCase = True
219loRegExp.Pattern = "((AND|[+&])\s*[\\(\\[\\{""].*[\\)\\]\\}""])|((AND\s|[+&])\s*\b[-\w']+\b)"
220Set loRequiredWords = loRegExp.Execute(asKeywords)
221asKeywords = loRegExp.Replace(asKeywords, "")
222loRegExp.Pattern = "(((NOT|[-])\s*)?[\\(\\[\\{""].*[\\)\\]\\}""])|(((NOT\s+|[-])\s*)\b[-\w']+\b)"
223Set loUnwantedWords = loRegExp.Execute(asKeywords)
224asKeywords = loRegExp.Replace(asKeywords, "")
225loRegExp.Pattern = "(((OR|[|])\s*)?[\\(\\[\\{""].*[\\)\\]\\}""])|(((OR\s+|[|])\s*)?\b[-\w']+\b)"
226Set loOptionalWords = loRegExp.Execute(asKeywords)
227asKeywords = loRegExp.Replace(asKeywords, "")
228If Not loRequiredWords.Count = 0 Then
229' REQUIRED
230lsSQL = lsSQL & "("
231For lnIndex = 0 To loRequiredWords.Count - 1
232lsKeyword = loRequiredWords.Item(lnIndex).Value
233loRegExp.Pattern = "^(AND|[+&])\s*"
234lsKeyword = loRegExp.Replace(lsKeyword, "")
235loRegExp.Pattern = "[()""\\[\\]{}]"
236lsKeyword = loRegExp.Replace(lsKeyword, "")
237lsKeyword = Replace(lsKeyword, "'", "''")
238If Not lnIndex = 0 Then
239lsSQL = lsSQL & " AND "
240End If
241lsSQL = lsSQL & "(" & Join(asFieldAry, " LIKE '%" & lsKeyword & "%' OR ")
242& " LIKE '%" & lsKeyword & "%')"
243Next
244lsSQL = lsSQL & ")"
245End If
246If Not loOptionalWords.Count = 0 Then
247' OPTIONAL
248If lsSQL = "" Then
249lsSQL = lsSQL & "("
250Else
251lsSQL = lsSQL & " AND ("
252End If
253For lnIndex = 0 To loOptionalWords.Count - 1
254lsKeyword = loOptionalWords.Item(lnIndex).Value
255loRegExp.Pattern = "^(OR|[|])\s*"
256lsKeyword = loRegExp.Replace(lsKeyword, "")
257loRegExp.Pattern = "[()""\\[\\]{}]"
258lsKeyword = loRegExp.Replace(lsKeyword, "")
259lsKeyword = Replace(lsKeyword, "'", "''")
260If Not lnIndex = 0 Then
261lsSQL = lsSQL & " OR "
262End If
263lsSQL = lsSQL & "(" & Join(asFieldAry, " LIKE '%" & lsKeyword & "%' OR ")
264& " LIKE '%" & lsKeyword & "%')"
265Next
266lsSQL = lsSQL & ")"
267End If
268If Not loUnwantedWords.Count = 0 Then
269' UNWANTED
270If lsSQL = "" Then
271lsSQL = lsSQL & "NOT ("
272Else
273lsSQL = lsSQL & " AND Not ("
274End If
275For lnIndex = 0 To loUnwantedWords.Count - 1
276lsKeyword = loUnWantedWords.Item(lnIndex).Value
277loRegExp.Pattern = "^(NOT|[-])\s*"
278lsKeyword = loRegExp.Replace(lsKeyword, "")
279loRegExp.Pattern = "[()""\\[\\]{}]"
280lsKeyword = loRegExp.Replace(lsKeyword, "")
281lsKeyword = Replace(lsKeyword, "'", "''")
282If Not lnIndex = 0 Then
283lsSQL = lsSQL & " OR "
284End If
285lsSQL = lsSQL & "(" & Join(asFieldAry, " LIKE '%" & lsKeyword & "%' OR ")
286& " LIKE '%" & lsKeyword & "%')"
287Next
288lsSQL = lsSQL & ")"
289End If
290If Not lsSQL = "" Then lsSQL = "(" & lsSQL & ")"
291buildQuery = lsSQL
292End Function
293'---------------------------------------
294' ----------------------------------------
295'