www.gusucode.com > 翼动留言板 2.1源码程序 > inc/DBControl.asp
<% '************************************************************************************ '开发组 翼动工作室 '姓名 郑景德 '网名 旭日 'QQ 3178920 '个人网站 http://www.wingroom.com '本页: '数据库控制类 ' '************************************************************************************ Class DBControl Public Conn, DBType '初始化类 Private Sub Class_Initialize DBType = Cfg.DataBase_Type End Sub '函数:创建数据库链接 '返回:链接对象 Public Function Open() Set Conn = Server.CreateObject("ADODB.CONNECTION") On Error Resume Next Conn.Open Cfg.ConnStr If Err Then Response.Write("系统出错,找不到相应的数据库,请与管理员联系!") Response.End End If End Function '函数:关闭数据库链接 '参数:链接串 Public Function Close() Conn.Close Set Conn = Nothing End Function '函数:创建数据库RecordSet对象 '参数:链接串 '返回:链接对象 Public Function CreateRS() Set CreateRS = Server.CreateObject("ADODB.RecordSet") End Function '函数:根据当前数据库类型转换Sql脚本 '参数:Sql串 '返回:转换结果Sql串 Public Function SqlTran(Sql) If DBType = "ACCESS" Then SqlTran = SqlServer_To_Access(Sql) Else SqlTran = Sql End If End Function '函数:数据库脚本执行(代Sql转换) '参数:Sql脚本 '返回:执行结果 '说明:本执行可自动根据数据库类型对部分Sql基础语法进行转换执行 Public Function ExeCute(Sql) On Error Resume Next Sql = SqlTran(Sql) Set ExeCute = Conn.ExeCute(Sql) If Err.Number <> 0 Then Response.Write "数据库脚本执行失败!(时间:" & Now() & "),<a href=""javascript:history.back();void(0);"">返回</a><br><b>错误:</b><div style='color:red;border:1 solid #C0C0C0 ;padding:5px;background-color:#F6F6F6'>" & Err.Description & Err.Source & "</div>" If Cfg.PrintDBSqlWithError Then Response.Write "<b>错误脚本:</b><div style='color:red;border:1 solid #C0C0C0 ;padding:5px;background-color:#F6F6F6'>"&Sql&"</div>" End If Response.End End If End Function '函数:数据库脚本执行 '参数:Sql脚本 '返回:执行结果 Public Function ExeCute2(Sql) Set ExeCute2 = Conn.ExeCute(Sql) End Function '函数:SqlServer(97-2000) to Access(97-2000) '参数:Sql,数据库类型(ACCESS,SQLSERVER) '说明: Public Function SqlServer_To_Access(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\([\s]?(second|minute|hour|day|month|year)[\s]?\,[\s]?(.+?)[\s]?\,[\s]?(.+?)([\s]?\)[\s]?)" Set Matches = regEx.ExeCute(Sql) Dim temStr For Each Match In Matches temStr = "DATEDIFF(" Select Case lcase(Match.SubMatches(0)) Case "second" : temStr = temStr & "'s'" Case "minute" : temStr = temStr & "'n'" Case "hour" : temStr = temStr & "'h'" Case "day" : temStr = temStr & "'d'" Case "month" : temStr = temStr & "'m'" Case "year" : temStr = temStr & "'y'" End Select temStr = temStr & "," & Match.SubMatches(1) & "," & Match.SubMatches(2) & Match.SubMatches(3) 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 SqlServer_To_Access = Sql End Function End Class %>