asp Access和ms SQL2000 2005共用数据库操作类
asp教程 Access和ms SQL2000 2005共用数据库教程操作类
<%
'====================================
'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 "<div style=""font-family:Arial,Verdana; font-size:12px;"">"& Cfg.sysVersion &"配置错误("& Now() &") <a href=""javascript教程:history.back();"">返回</a> <a href=""javascript:location.reload();"">重试</a><br /><br />错误源:<br /><span style=""color:#FF0000"">系统不支持的数据库类型</span><br />错误描述:<br /><span style=""color:#FF0000"">无法识别的数据库类型</span>"
Response.Write "</div>"
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 "<div style=""font-family:Arial,Verdana; font-size:12px;"">"& Cfg.sysVersion &"执行错误("& Now() &") <a href=""javascript:history.back();"">返回</a> <a href=""javascript:location.reload();"">重试</a><br /><br />错误源:<br /><span style=""color:#FF0000"">数据库连接错误</span><br />错误描述:<br /><span style=""color:#FF0000"">" & ErrorInfo & "</span>"
Response.Write "</div>"
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 "<div style=""font-family:Arial,Verdana; font-size:12px;"">"& Cfg.sysVersion &"SQL语句执行错误("& Now() &") <a href=""javascript:history.back();"">返回</a> <a href=""javascript:location.reload();"">重试</a><br /><br />错误源:<br /><span style=""color:#FF0000"">"& Err.Source &"</span><br />错误描述:<br /><span style=""color:#FF0000"">"& Err.Description &"</span>"
if Cfg.PrintErrorSql Then Response.Write "<br />错误语句如下:<br /><span style=""color:#FF0000"">"& Sql &"</span>"
Response.Write "</div>"
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 "<div style=""font-family:Arial,Verdana; font-size:12px;"">"& Cfg.sysVersion &"SQL语句执行错误("& Now() &") <a href=""javascript:history.back();"">返回</a> <a href=""javascript:location.reload();"">重试</a><br /><br />错误源:<br /><span style=""color:#FF0000"">"& Err.Source &"</span><br />错误描述:<br /><span style=""color:#FF0000"">"& Err.Description &"</span>"
if Cfg.PrintErrorSql Then Response.Write "<br />错误语句如下:<br /><span style=""color:#FF0000"">"& Sql &"</span>"
Response.Write "</div>"
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&"<br>")
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 &"'"&"<br>")
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)&"<br>")
Conn.Execute(this(I))
If Conn.Errors.Count>0 Then
Response.Write "<div style=""font-family:Arial,Verdana; font-size:12px;"">"& Cfg.sysVersion &"SQL语句执行错误("& Now() &") <a href=""javascript:history.back();"">返回</a> <a href=""javascript:location.reload();"">重试</a><br /><br />错误源:<br /><span style=""color:#FF0000"">"& Err.Source &"</span><br />错误描述:<br /><span style=""color:#FF0000"">"& Err.Description &"</span>"
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
%>
补充：asp教程,高级应用
