一个普通的数据库例子源源程序

　2000-10-13 10:09:39　来源：WEB开发网　　　

核心提示： To assist in interfacing with databases. This script can format variables and return SQL formats. Such as double quoting apposterphies and surrounding strings

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