<%
Class Cls_DataBase
	' @ 私有变量
	Private Con            ' @ 数据库连接对象
	Private ConnStr        ' @ 数据库连接字符串
	Private DbType         ' @ 数据库类型　　( 0 = Access, 1 = MSSQL, 2 = MySQL )
	Private DbTable        ' @ 数据库名
	Private DbPath         ' @ 为Access数据库时，数据库文件的安装目录，必须无Root_Path
	Private DbCharSet      ' @ 为MySQL数据库时，数据库字符集
	Private DbServer       ' @ 数据库服务器IP
	Private DbUser         ' @ 数据库连接用户名
	Private DbPass         ' @ 数据库存连接密码
	Private QueryNum       ' @ SQL查询次数
	
	'--------------------------------------------------------
	' @ 初始化类
	Private Sub Class_Initialize
		DbType   = "access"
		DbPath   = ""
		QueryNum = 0
	End Sub
	
	'--------------------------------------------------------
	' @ 函数:取得数据库连接字符串
	' @ 返回:字符串
	Private Function GetConnStr()
		Select Case CStr(DbType)
		Case "mssql"
			ConnStr = "Driver={SQL Server};server="&DbServer&";uid="&DbUser&";password="&DbPass&";DataBase="&DbTable&""
			ConnStr = "PROVIDER=SQLOLEDB.1;Data Source="&DbServer&";Initial Catalog="&DbTable&";Persist Security Info=True;User ID="&DbUser&";Password="&DbPass&";Connect Timeout=30"
		Case "mysql"
			ConnStr = "Driver={MySQL ODBC 3.51 Driver};server="&DbServer&";uid="&DbUser&";pwd="&DbPass&";database="&DbTable&""
		Case "access"
			ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0; Data Source =" & Server.MapPath(DbPath & DbTable & ".mdb")
		End Select
		GetConnStr = ConnStr
	End Function
	
	'--------------------------------------------------------
	' @ 函数:设置数据库类型
	Public Property Let Db_Type(ByVal vDbType)
		DbType = LCase(TRim(vDbType))
	End Property
	
	'--------------------------------------------------------
	' @ 函数:设置AC连接时的数据库路径,格式必须为"Data/"或者"./Data/"，前必须无"/"，后必须有
	Public Property Let Db_Path(ByVal vDbPath)
		DbPath = vDbPath
	End Property
	
	'--------------------------------------------------------
	' @ 函数:设置MySql连接时的数据库字符集
	Public Property Let Db_CharSet(ByVal vDbCharSet)
		DbCharSet = vDbCharSet
	End Property
	
	'--------------------------------------------------------
	' @ 函数:设置数据库名
	Public Property Let Db_Table(ByVal vDbTable)
		DbTable = vDbTable
	End Property
	
	'--------------------------------------------------------
	' @ 函数:设置数据库服务器IP
	Public Property Let Db_Server(ByVal vDbServerIP)
		DbServer = vDbServerIP
	End Property
	
	'--------------------------------------------------------
	' @ 函数:设置数据库用户名
	Public Property Let Db_UserName(ByVal vDbUserName)
		DbUser = vDbUserName
	End Property
	
	'--------------------------------------------------------
	' @ 函数:设置数据库用户密码
	Public Property Let Db_UserPass(ByVal vDbUserPass)
		DbPass = vDbUserPass
	End Property
	
	'--------------------------------------------------------
	' @ 函数:返回数据库查询次数
	Public Property Get QueryTotal()
		QueryTotal = QueryNum
	End Property
	
	'--------------------------------------------------------
	' @ 函数:返回数据库类型
	Public Property Get Types()
		Types = DbType
	End Property
	
	'--------------------------------------------------------
	' @ 函数:返回Conn对象
	Public Property Get Conn()
		Set Conn = Con
	End Property
	
	'--------------------------------------------------------
	' @ 函数:创建数据库链接
	' @ 返回:链接对象
	Public Function Open()
		On Error Resume Next
		Set Con = Server.CreateObject("ADODB.CONNECTION")
		Con.Open GetConnStr
		If CStr(DbType) = "mysql" Then
			Cnn.Execute("SET NAMES '"&DbCharSet&"'")
		End If
		If Err.Number <> 0 Then
			' @ 设置错误信息返回到调用应用程序
			Err.Raise vbObjectError + 1, "数据库控制类","请确定数据库路径名称拼写是否正确，以及是否连接到文件存放的服务器。"
			Class_Err
		End If
	End Function
	
	'--------------------------------------------------------
	' @ 函数:关闭数据库链接
	' @ 返回:链接对象
	Public Function Close()
		Con.Close
		Set Con = Nothing
	End Function
	
	'--------------------------------------------------------
	' @ 函数:统计字段
	' @ 返回:数字
	Public Function Count(byVal Sql)
		Count = 0
		Dim RsCount:Set RsCount = Execute(Sql)
		If Not RsCount.Eof Then Count = RsCount(0)
		RsCount.Close
		Set RsCount = Nothing
	End Function
	
	Public Function getFields(byVal Sql)
		Dim vL1
		Dim Rs1:Set Rs1 = Execute(Sql)
		While Not Rs1.Eof
			vL1 = vL1 & Rs1(0) & ","
			Rs1.MoveNext
		Wend
		vL1 = Left(vL1,Len(vL1)-1)
		Rs1.Close:Set Rs1 = Nothing
		getFields = vL1
	End Function
	'--------------------------------------------------------
	' @ 函数:创建数据库RecordSet对象
	' @ 返回:链接对象
	Public Function CreateRS()
		Set CreateRS = Server.CreateObject("ADODB.RecordSet")
	End Function
	
	'--------------------------------------------------------
	' @ 函数:根据当前数据库类型转换Sql脚本
	' @ 参数:Sql串
	' @ 返回:转换结果Sql串
	Public Function SqlTran(byVal Sql)
		If CStr(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 = Server.CreateObject("ADODB.RecordSet")
		ExeCute.Open Sql,Con,1,1
		'Set ExeCute = Con.ExeCute(Sql)
		QueryNum = QueryNum + 1
		If Err.Number <> 0 Then
			' @ 设置错误信息返回到调用应用程序
			Err.Raise vbObjectError + 1, "数据库控制类", Err.Source & " " & Err.Description
		'	Class_Err
		End If
	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 & "'mR'"
				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
	'--------------------------------------------------------
	' @ 函数: 字段是否存在
	Public Function IsFieldExist(ByVal Table,ByVal Field)
		On Error Resume Next
		Err.Clear
		Con.Execute("select " & Field & " from " & Table)
		Select Case Err.Number
		Case 0
			IsFieldExist = True
		Case Else
			IsFieldExist = False
		End Select
		Err.Clear
	End Function
	'--------------------------------------------------------
	' @ 函数: 压缩数据库
	Public Function Press()
		Dim vL1, vL2, Engine
		On Error Resume Next
		Con.Close:Set Con = Nothing
		DelFile "___temp.asp"
		vL1 = DbPath & DbTable & ".mdb"
		vL2 = Server.MapPath(DbPath & DbTable & ".mdb")
		Set Engine = CreateObject("jro.jetengine")
			Engine.compactdatabase "provider=microsoft.jet.oledb.4.0;data source=" & vL2, _
			"provider=microsoft.jet.oledb.4.0;data source=" & Server.MapPath("___temp.asp")
		Set Engine = Nothing
		CopyFile "___temp.asp",vL1
		DelFile "___temp.asp"
		If Err.Number <> 0 Then Err.Clear
	End Function
	'--------------------------------------------------------
	' @ 函数:处理错误
	Private Function Class_Err()
		With Response
			.Clear
			.Write "<div style=""font-family: Tahoma, Verdana, System;font-size: 12px;color: #333333;"">"&vbCrLf
			.Write Err.Source&vbCrLf
			.Write "<hr style=""border: dashed #d1d7dc 0px;border-top-width: 1px;height: 0px;"" />"&vbCrLf
			.Write "<ol>"&vbCrLf
			.Write "<li>"&Err.Description&"</li>"&vbCrLf
			'If PrintDBSqlWithError Then
			'	Response.Write "<li>SQL语句:"&Sql&"</li>"
			'End If
			.Write("</ol></div>"&vbCrLf)
		End With
		Err.Clear
		Response.End
	End Function
	
	' @ 注消类
	Private Sub Class_Terminate
		
	End Sub
End Class
%>
