一个普通的数据库例子源源程序 -pc6资讯

您的位置：首页 → 技术开发 → ASP技巧 → 一个普通的数据库例子源源程序

一个普通的数据库例子源源程序 时间：2004/11/7 4:03:00来源：本站整理作者：蓝点我要评论(0):      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 "
" & err.description & "
" & asSQL & "

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

    '---------------------------------------

    '     ----------------------------------------

    '

    %>

文章评论

查看所有0条评论>>

热门文章 没有查询到任何记录。