【www.gdgbn.com--Access】

<%

"====================================
"H----------Access和SQL共用数据库操作类,所有SQL语句以SQL为准
"====================================
Class DbClass
    Public Conn
 Private ConnStr
 Private ErrorInfo

    "初始化类
    Public Sub Class_Initialize
  Select Case Cfg.DBType
   Case "MSSQL"
    ConnStr = "Provider = Sqloledb; User ID = "& Cfg.SqlUsername &"; Password = "& Cfg.SqlPassword &"; Initial Catalog = "& Cfg.SqlDatabaseName &"; Data Source = "& Cfg.SqlLocalName &";"
   Case "MSSQL_W"
    ConnStr = "Provider = Sqloledb;Integrated Security = SSPI;Persist Security Info = False;Data Source =.;Initial Catalog = "& Cfg.SqlDatabaseName &";"
   Case "AC"
    ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = "& Server.Mappath(Cfg.dbPath)
   Case Else
    Response.Write ""& Cfg.sysVersion &"配置错误("& Now() &") javascript教程:history.back();"">返回 重试

错误源:
系统不支持的数据库类型
错误描述:
无法识别的数据库类型"
    Response.Write ""
    Response.End()
  End Select
    End Sub

    "函数:创建数据库链接
    Public Function DbOpen()
  If IsObject(Conn) Then Exit Function
  Set Conn = Server.CreateObject(Cfg.nConnectionObject)
  If Conn.State = 1 Then Exit Function
  On Error Resume Next
  Conn.Open ConnStr
  If Err.Number Then
   ErrorInfo = Err.Description
   Err.Clear
   Set Conn = Nothing
   Response.Write ""& Cfg.sysVersion &"执行错误("& Now() &") 返回 重试

错误源:
数据库连接错误
错误描述:
" & ErrorInfo & ""
   Response.Write ""
   Response.End()
  End If
    End Function

    "函数:关闭数据库链接
    "参数:链接串
    Public Function DbClose()
  If Not IsObject(Conn) Then Exit Function
  If Conn.State = 0 Then Exit Function
  Conn.Close:Set Conn = Nothing
 End Function

    "函数:创建数据库RecordSet对象
    "参数:链接串
    Public Function RecordSet(obj)
        Set obj = Server.CreateObject(Cfg.nRecordSetObject)
    End Function

    "函数:根据当前数据库类型转换Sql脚本
    "参数:Sql串
    "返回:转换结果Sql串
    Public Function SqlTran(Sql)
        If Cfg.DBType = "AC" Then
            SqlTran = Sql2Access(Sql)
        Else
            SqlTran = Sql
        End If
    End Function

    "函数:数据库脚本执行(代Sql转换)
    "参数:Sql脚本
    "返回:执行结果
    "说明:本执行可自动根据数据库类型对部分Sql基础语法进行转换执行
    Public Function Execute(Sql)
        Sql = SqlTran(Sql)
  On Error Resume Next
  DbOpen()
        Set Execute = Conn.Execute(Sql)
        If Err.Number <> 0 Then
            Response.Write ""& Cfg.sysVersion &"SQL语句执行错误("& Now() &") 返回 重试

错误源:
"& Err.Source &"
错误描述:
"& Err.Description &""
   if Cfg.PrintErrorSql Then Response.Write "
错误语句如下:
"& Sql &""
   Response.Write ""
   Response.End()
  End If
  If Err <> 0 Then Err.Clear
    End Function

    "函数:执行SQL返回二维数组
    "参数:Sql脚本
    "返回:二维数组对象
    Public Function Query(Sql)
  Dim RsTmp,TmpArray
  Sql = SqlTran(Sql)
  On Error Resume Next
  DbOpen()
  Set RsTmp=Conn.Execute(Sql)
        If Err.Number <> 0 Then
            Response.Write ""& Cfg.sysVersion &"SQL语句执行错误("& Now() &") 返回 重试

错误源:
"& Err.Source &"
错误描述:
"& Err.Description &""
   if Cfg.PrintErrorSql Then Response.Write "
错误语句如下:
"& Sql &""
   Response.Write ""
   Response.End()
  End If
  If RsTmp.Eof Or RsTmp.Bof Then Exit Function
  TmpArray=RsTmp.GetRows()
  Set RsTmp=Nothing
  Query=TmpArray
    End Function
 
  "函数:执行SQL返回刚插入数据库记录的ID
 Public Function getIdenId(tableName)
  getIdenId=Conn.Execute("select IDENT_CURRENT("[" & cfg.TablePrefix & tableName & "]")")(0)
 End Function

 "[获取指定单字段记录]
 "scCol使用“|”分别分割唯一字段名,表名,条件约束字段名
 "scValue传递的指定参数
 "scNoneText无记录时的替代文字
 "Codes By konghu
 Public Function GetSpecialCol(scCol,scValue,scNoneText)
  Dim arrCol,Sql,Tmp
  arrCol = Split(scCol,"@")
  If IsNumeric(scNoneText) Then
   Sql = "Select " & arrCol(0) & " From ["& Cfg.tablePrefix &"" & arrCol(1) & "] Where " & arrCol(2) & " = " & scValue
  Else
   Sql = "Select " & arrCol(0) & " From ["& Cfg.tablePrefix &"" & arrCol(1) & "] Where " & arrCol(2) & " = "" & scValue & """
  End If
  "Response.Write(Sql&"
")
  Tmp = Query(Sql)
  If IsNull(Tmp) Or IsEmpty(Tmp) Then
   GetSpecialCol = scNoneText
  Else
   if isNull(Tmp(0,0)) = false then
    GetSpecialCol = Tmp(0,0)
   else
    GetSpecialCol = scNoneText
   end if
  End If
 End Function
 
 "作用:验证数据是否已存在(true不存在/false存在)
 "参数:值,字段,附加条件,表,ID
 Public Function ChkSameValue(value,field,whereStr,table,id)
  DbOpen()
  Dim temp,whereString
  If whereStr = "" Then
   whereString = ""
  Else
   whereString = whereStr &" AND "
  End if
  If id = "" Or IsNull(id) Or IsEmpty(id) then
   temp = Conn.Execute("SELECT COUNT(*) FROM ["& Cfg.tablePrefix & table &"] WHERE "& whereString & field &" = ""& value &""")(0)
  Else
   temp = Conn.Execute("SELECT COUNT(*) FROM ["& Cfg.tablePrefix & table &"] WHERE "& whereString & field &" = ""& value &"" AND id <> "& id)(0)
  End If
  rem response.write("SELECT COUNT(*) FROM ["& Cfg.tablePrefix & table &"] WHERE "& whereString & field &" = ""& value &"""&"
")
  If temp = 0 Then
   ChkSameValue = True
  Else
   ChkSameValue = False
  End if
 End Function

 "//批量语句事务处理
 Function BeginTran(this)
  If this = "" or Isnull(this) Then exit Function
  Dim I
  On Error Resume next
  DbOpen()
  this = split(this,"$split$")
  Conn.BeginTrans"//启动事务
  For I = 0 To uBound(this)
   response.write(this(I)&"
")
   Conn.Execute(this(I))
   If Conn.Errors.Count>0 Then
    Response.Write ""& Cfg.sysVersion &"SQL语句执行错误("& Now() &") 返回 重试

错误源:
"& Err.Source &"
错误描述:
"& Err.Description &""
    Conn.Errors.Clear
    Conn.RollBackTrans
    response.End()
   End If
  Next
  Conn.CommitTrans"//提交事务 
 End Function

    "函数:SqlServer to Access(97-2000)
    "参数:Sql,数据库类型(ACCESS,SQLSERVER)
    "说明:
    Private Function Sql2Access(Sql)
        Dim regEx, Matches, Match
        "创建正则对象
        Set regEx = New RegExp
        regEx.IgnoreCase = True
        regEx.Global = True
        regEx.MultiLine = True

        "转:GetDate()
        regEx.Pattern = "(?=[^"]?)GETDATE()(?=[^"]?)"
        Sql = regEx.Replace(Sql,"NOW()")

        "转:UPPER()
        regEx.Pattern = "(?=[^"]?)UPPER([s]?(.+?)[s]?)(?=[^"]?)"
        Sql = regEx.Replace(Sql,"UCASE($1)")

        "转:日期表示方式
        "说明:时间格式必须是2004-23-23 11:11:10 标准格式
        regEx.Pattern = ""([d]{4,4}-[d]{1,2}-[d]{1,2}(?:[s][d]{1,2}:[d]{1,2}:[d]{1,2})?)""
        Sql = regEx.Replace(Sql,"#$1#")

        regEx.Pattern = "DATEDIFF((.*?),"
        Set Matches = regEx.Execute(Sql)
        Dim temStr
        For Each Match In Matches
            temStr = "DATEDIFF("
            Select Case Trim(LCase(Match.SubMatches(0)))
                Case "s" :
                    temStr = temStr &""s","
                Case "n" :
                    temStr = temStr &""n","
                Case "h" :
                    temStr = temStr &""h","
                Case "d" :
                    temStr = temStr &""d","
                Case "m" :
                    temStr = temStr &""m","
                Case "y" :
                    temStr = temStr &""y","
            End Select
            Sql = Replace(Sql,Match.Value,temStr,1,1)
        Next

        "转:Insert函数
        regEx.Pattern = "CHARINDEX([s]?"(.+?)"[s]?,[s]?"(.+?)"[s]?)[s]?"
        Sql = regEx.Replace(Sql,"INSTR("$2","$1")")

        Set regEx = Nothing
        Sql2Access = Sql
    End Function

 "************************************
 "GetConn返回当链接对象
 "************************************
 Public Property Get GetConn
  DbOpen()
  Set GetConn = Conn
 End Property

 "注消类
    Private Sub Class_Terminate
        DbClose
    End Sub
End Class

Class SQLString"//SQL生成类
 "************************************
 "变量定义
 "************************************
 "sTableName ---- 表名
 "iSQLType ----SQL语句类型:0-增加,1-更新,2-删除,3-查询
 "sWhere ---- 条件
 "sOrder ---- 排序方式
 "sSQL ----值
 
 Private sTableName,iSQLType,sWhere,sOrder,sSQL
 
 "************************************
 "类初始化/结束
 "************************************
 Private Sub Class_Initialize()
  sTableName=""
  iSQLType=0
  sWhere=""
  sOrder=""
  sSQL=""
 End Sub
 
 Private Sub Class_Terminate()
 
 End Sub
 
 "************************************
 "属性
 "************************************
 "设置表名的属性
 Public Property Let TableName(value)
  sTableName=value
 End Property
 
 "设置条件
 Public Property Let Where(value)
  sWhere=value
 End Property
 
 "设置排序方式
 Public Property Let Order(value)
  sOrder=value
 End Property
 
 "设置查询语句的类型
 Public property Let SQLType(value)
  iSQLType=value
  Select case iSQLType
   Case 0
    sSQL="insert into {#0} ({#1}) values ({#2})"
   Case 1
    sSQL="update {#0} set {#1}={#2}"
   Case 2
    sSQL="delete from {#0} "
   Case 3
    sSQL="select {#1} from {#0} "
  End Select
 End Property
 
 "************************************
 "函数
 "************************************
 "增加字段(字段名称,字段值)
 
 Public Sub AddField(sFieldName,sValue)
  Select Case iSQLType
   Case 0
    sSQL=replace(sSQL,"{#1}",sFieldName & ",{#1}")
    sSQL=replace(sSQL,"{#2}",""" & sValue & "",{#2}")
   Case 1
    sSQL=replace(sSQL,"{#1}",sFieldName)
    sSQL=replace(sSQL,"{#2}",""" & sValue & "",{#1}={#2}")
   Case 3
    sSQL=replace(sSQL,"{#1}",sFieldName & ",{#1}")
  End Select
 End Sub
 
 "返回SQL语句
 Public Function ReturnSQL()
  sSQL=replace(sSQL,"{#0}",sTableName)
  Select Case iSQLType
  Case 0
   sSQL=replace(sSQL,",{#1}","")
   sSQL=replace(sSQL,",{#2}","")
  Case 1
   sSQL=replace(sSQL,",{#1}={#2}","")
  Case 3
   sSQL=replace(sSQL,",{#1}","")
  End Select
  
  If sWhere<>"" Then
   sSQL=sSQL & " where " & sWhere
  End If
  If sOrder<>"" Then
   sSQL=sSQL & " order by " & sOrder
  End If
  ReturnSQL=sSQL
 End Function
 
 "清空语句
 Public Sub Clear()
  sTableName=""
  iSQLType=0
  sWhere=""
  sOrder=""
  sSQL=""
 End Sub
 
End Class
%>

本文来源:http://www.gdgbn.com/shujuku/23748/