<%
'=======================================================================
' CLASS NAME: clsDB
' DESIGN BY : 彭国辉
' DATE: 2003-12-18
' SITE: http://kacarton.yeah.net/
' EMAIL: kacarton@sohu.com
' MODIFY:
' 2004-6-25: 升级后的数据引擎，返回错误代号小于0（也可以是ASP对数值的
' 定义有变），修改错误检测err.number>0 ==> err.number<>0
' 2004-6-30：修改错误处理，忽略如游标类型改变等非错误性质的提示
'=======================================================================
Class clsDB
' name of this class
' var string
' @access Private
' @see property: Name
Private m_strName
' version of this class
' var string
' @access Private
' @see property: Version
Private m_strVersion
' Error Object
' @var ADODB.Connection.Errors
' @access private
' @see property: LastError
Private m_LastError
' Ingore all Connection.Errors
' var Boolean
' @access private
' @see property: IgnoreError
Private m_IgnoreError
' Connection Object
' var ADODB.Connection
' @access Private
' @see property: Connection
Private m_Connection
' Is connection to database?
' var boolean
' @Private
Private m_bIsConnect
' RecordSet
' var RecordSet
' @access Private
Private m_RecordSet
' Connection string
' var string
' @access Private
' @see property: ConnectionString
Private m_ConneStr
' Database server host name or IP
' var string
' @access Private
' @see property: Host
Private m_strHost
' Database name
' var string
' @access Private
' @see property: Database
Private m_strDatabase
' Account to connection database
' var string
' @access Private
' @see property: UserName
Private m_UserName
' Password to connection database
' var string
' @access Private
' @see property: Password
Private m_Password
' get class name attribute.
' usage: oTemplate.Name
' access public
Public Property Get ClassName()
ClassName = m_strName
End Property
' get class version attribute.
' usage: oTemplate.Version
' access public
Public Property Get Version()
Version = m_strVersion
End Property
' Get class last error messages.
' usage: oTemplate.LastError
' @access public
Public Property Get LastError()
LastError = m_LastError
End Property
' Get or Set Ignore connection.errors
Public Property Get IgnoreError()
IgnoreError = m_IgnoreError
End Property
Public Property Let IgnoreError(ByVal Value)
m_IgnoreError = Value
End Property
' Get Connection
Public Property Get Connection()
Connection = m_Connection
End Property
' Get connection string
Public Property Get ConnectionString()
ConnectionString = m_ConneStr
End Property
' Set connection string
Public Property Let ConnectionString(ByVal Value)
m_ConneStr = Value
End Property
' Get data fields count
Public Property Get FieldCount()
FieldCount = m_RecordSet.Fields.Count
End Property
' Get RecordSet PageSize
Public Property Get PageSize()
on error resume next
PageSize = m_RecordSet.PageSize
if err.number<>0 then ShowError(Can not get PageSize!)
End Property
' Set RecordSet Page Size
Public Property Let PageSize(ByVal Value)
on error resume next
m_RecordSet.PageSize = Value
if err.number<>0 then ShowError(Can not set PageSize to & Value)
End Property
' Get RecordSet page count
Public Property Get PageCount()
PageCount = m_RecordSet.PageCount
End Property
' Get RecordSet record count
Public Property Get RecordCount()
on error resume next
RecordCount = m_RecordSet.RecordCount
if err.number<>0 then ShowError(Get RecordCount error.)
End Property
' Get RecordSet Absolute Page
Public Property Get AbsolutePage()
on error resume next
AbsolutePage = m_RecordSet.AbsolutePage
if err.number<>0 then ShowError(Can not get AbsolutePage!)
End Property
' Set RecordSet Absolute Page
Public Property Let AbsolutePage(ByVal Value)
on error resume next
m_RecordSet.AbsolutePage = Value
if err.number<>0 then ShowError(Can not set AbsolutePage to & Value)
End Property
' Get RecordSet Absolute Position
Public Property Get AbsolutePosition()
on error resume next
AbsolutePosition = m_RecordSet.AbsolutePosition
if err.number<>0 then ShowError(Can not get AbsolutePosition!)
End Property
' Set RecordSet Absolute Position
Public Property Let AbsolutePosition(ByVal Value)
on error resume next
m_RecordSet.AbsolutePosition = Value
if err.number<>0 then ShowError(Can not set AbsolutePosition to & Value)
End Property
' Bof
Public Property Get Bof()
Bof = m_RecordSet.Bof
end Property
' Eof
Public Property Get Eof()
Eof = m_RecordSet.EOF
end Property
'Setup the databease host name, database name, User name(account), password
Public Sub Setup(Account, Password, Database, Host)
m_UserName = Account
m_Password = Password
if Database<> then m_strDatabase = Database
if Host<> then m_strHost = Host
m_ConneStr = Driver={SQL Server};Server= & m_strHost & ;Database= &_
m_strDatabase & ;Uid= & m_UserName & ;Pwd= & m_Password & ;
End Sub
' Connect to database
Public Function Connect()
on error resume next
m_Connection.Open m_ConneStr
if err.number<>0 Then ShowError(数据库连接错误:(Server: & m_strHost & , Database: & m_strDatabase & ))
m_bIsConnect = true
Connect = true 'todo://
end Function
' Diconnect database
Public Function Close()
on error resume next
Set m_RecordSet = Nothing
Set m_Connection = Nothing
m_bIsConnect = false
Close = true
if err.number<>0 then ShowError(切断数据库连接时出错)
end Function
' Query
Public Sub Query(SQLCommand)
on error resume Next
if not m_bIsConnect then Connect
Set m_RecordSet = Server.CreateObject(Adodb.Recordset)
'Set m_RecordSet = m_Connection.Execute(SQLCommand)
m_RecordSet.Open SQLCommand, m_Connection, 1, 1
if err.number<>0 then ShowError(SQLCommand):exit sub
if m_Connection.Errors.Count>0 And m_IgnoreError=false then ProcessError(SQLCommand)
End Sub
' ExeSQL Command
Public Sub ExeSQL(SQLCommand)
on error resume Next
if not m_bIsConnect then Connect
m_Connection.Execute SQLCommand
if err.number<>0 then ShowError(SQLCommand):exit sub
if m_Connection.Errors.Count>0 And m_IgnoreError=false then ProcessError(SQLCommand)
End Sub
' Get Fields Name
Public Function FieldName(ByVal FieldId)
on error resume next
FieldName = m_RecordSet.Fields(FieldId).Name
if err.number<>0 then ShowError(不能读取字段 & FieldID & 名称!)
End Function
' Get fields data
Public Function Fields(ByVal FieldId)
on error resume next
Fields = m_RecordSet.Fields(FieldId)
if err.number<>0 then ShowError(不能读取字段 & FieldID & 数据!)
End Function
' Get fields data
Public Function Data(ByVal FieldId)
on error resume next
Data = m_RecordSet.Fields(FieldId)
if err.number<>0 then ShowError(不能读取 & FieldID & 数据!)
'if m_Connection.Errors.Count>0 then ShowError(不能读取 & FieldID & 数据!)
End Function
' Move to next record
Public Sub MoveNext()
on error resume next
if m_bIsConnect then m_RecordSet.MoveNext
if err.number<>0 then ShowError(MoveNext error)
End Sub
' Move to Previous record
Public Sub MovePrevious()
on error resume next
if m_bIsConnect then m_RecordSet.MovePrevious
if err.number<>0 then ShowError(MovePrevious error)
End Sub
' Move to First record
Public Sub MoveFirst()
on error resume next
if m_bIsConnect then m_RecordSet.MoveFirst
if err.number<>0 then ShowError(MoveFirst error)
End Sub
' Move to Last record
Public Sub MoveLast()
on error resume next
if m_bIsConnect then m_RecordSet.MoveLast
if err.number<>0 then ShowError(MoveLast error)
End Sub
' 2004-6-30
Private Sub ProcessError(ByVal sqltxt)
for i=0 to m_Connection.Errors.Count-1
If m_Connection.Errors.Item(i).Number<>0 Then ShowError(sqltxt)
Next
End Sub
' This function is called whenever an error occurs and will handle the error
' Additionally the error message will be saved in m_strLastError.
' @param $msg a string containing an error message
' @access private
' @return void
Private Sub ShowError(ByVal sqltxt)
for i=0 to m_Connection.Errors.Count-1
Response.Write m_Connection.Errors.Item(i) & ( & m_Connection.Errors.Item(i).Number & )<br>
Next
m_LastError = Err.Description
m_Connection.Errors.Clear
Response.Write <br>------------------------------------------------------<br> &_
<font color=red size=4> & sqltxt & </font>
' Response.Write <br>------------------------------------------------------<br> &_
' <font color=red size=4> & Left(sqltxt, 10) & ...(错误信息已被屏蔽)，请与网站管理员联系！</font>
' Response.End
End Sub
' Class constructor, set class default attributes, you can change it
Private Sub class_Initialize
m_strName = clsDB
m_strVersion = 1.0
Set m_Connection = Server.CreateObject(ADODB.Connection)
'请修改此处为你连接数据库的默认值
Setup sa, password, Northwind, (local)
m_bIsConnect = False
m_IgnoreError = False
End Sub
' Class destructor, free memory.
Private Sub class_Terminate
Set m_RecordSet = Nothing
Set m_Connection = Nothing
End Sub
End Class
%>
| 
