一聚教程网:一个值得你收藏的教程网站

热门教程

asp Access和ms SQL2000 2005共用数据库操作类

时间:2022-07-02 23:05:03 编辑:袖梨 来源:一聚教程网

<%

'====================================
'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
%>