ASP中一个数据库操作类

来源：互联网发布：mysql update select 编辑：程序博客网时间：2024/05/01 17:49

'是否隐藏错误信息的选项，true=显示，false=隐藏
const IS_DEBUG = true

Class Conn
Public objcn
Private ConnStr
Private ErrInfo
Private ExecuteCnt
Private time_start
private m_DateBaseType
Private ConnectionString
'初始化类
Private Sub Class_Initialize()
  time_start = timer()
  set ErrInfo = new ErrQueue
  ExecuteCnt = 0
End Sub

'设置数据库连接字符串
Public Sub SetConnString(ConnectionString, DateBaseType)
  ConnStr = ConnectionString
  If DateBaseType = 1 Then
   m_DateBaseType = "SQL Server"
  Else
   m_DateBaseType = "Access"
  End if
End Sub

'连接到数据库，没有在构造函数中调用，只在需要操作数据库时才调用
Public Sub connectionDateBase
  'If Not IS_DEBUG Then
  On Error Resume Next
  set objcn = Server.CreateObject("ADODB.Connection")
  objcn.open ConnStr
  if Err Or objcn.State <> 1 then
   Err.clear
   AddErr "连接数据库时出错，请与系统管理员联系！"
   PrintErr "连接数据库"
'  Else
'   Response.WRite "连接成功！"
  End if
End Sub

'关闭数据库连接
Public Sub CloseDateBase()
  objcn.Close : Set objcn = Nothing
End Sub

'执行一条SQL语句
Public Function ExecuteSql(s_commend)
  If Not IS_DEBUG Then On Error Resume Next
  ExecuteCnt = ExecuteCnt + 1
  set ExecuteSql = objcn.execute(s_commend, , 1)
  if Err then
   Err.clear
   AddErr ""
'   AddErr "错误的SQL语句为：<br>" & s_commend
   PrintErr ""
  End if
End Function

'打开一个记录集
   Public Function OpenRecordSet(sqlCommand, CursorType, LockType, CursorLocation)
If Not IS_DEBUG Then On Error Resume Next
        Dim objrs
        Set objrs = Server.CreateObject("ADODB.RecordSet")
        objrs.ActiveConnection = objcn
        objrs.CursorLocation = CursorLocation
        objrs.CursorType = CursorType
        objrs.LockType = LockType
        objrs.Open sqlCommand
        ExecuteCnt = ExecuteCnt + 1
        If Err Then
                Err.Clear
                AddErr "打开数据库记录集时出错！请与管理员联系！"
'  AddErr "错误的SQL语句为：<br>" & sqlCommand
                PrintErr "打开数据库记录"
        End If
        Set OpenRecordSet = objrs
    End Function

'获取记录集，如果有数据，把指针指向到指定页的首记录处
's_command 要执行的SQL语句
'pageSize 每页显示的记录条数
'intpage 要显示第几页
's_url 页面转换的链接，如"page.asp?page="
'pageinfo 传出参数，接收页面导航的链接

Public Function getPage(s_command, pageSize, intpage, s_url, ByRef pageInfo)
  If Not IS_DEBUG Then On Error Resume Next
  Dim objrs
  ExecuteCnt = ExecuteCnt + 1
  set objrs = Server.CreateObject("ADODB.RecordSet")
  objrs.cacheSize = pageSize
  objrs.open s_command, objcn, 3, 1, 1
  If Err Then
   AddErr "SQL = '" & s_command & "'"
   PrintErr "获取分页记录"
   Exit function
  End If
  if objrs.bof and objrs.eof then
   pageInfo = pageInfo & " 共 <font color=""#FF0000"">0</font> 条记录 | <font color=""#FF0000"">" &_
     intpage & "</font>/0 | "
   set getPage = Nothing
  Else
   objrs.pageSize = pageSize
   Dim recCnt, pageCnt
   recCnt = objrs.recordCount
   if recCnt Mod pageSize > 0 then
    pageCnt = int(recCnt / pageSize) + 1
   else
    pageCnt = recCnt / pageSize
   End if
   if intpage < 1 then intpage = 1
   if intpage > pageCnt then intpage = pageCnt
   pageInfo = pageInfo & " 共 <font color=""#FF0000"">" & recCnt & "</font> 条记录 | <font color=""#FF0000"">" &_
     intpage & "</font>/" & pageCnt & " | "
   if intpage > 1 then
    pageInfo = pageInfo & "<a href=""" & s_url & (intpage - 1) & """>上一页</a> "
   else
         pageInfo = pageInfo & "<font color=""#CCCCCC"">上一页</font> "
        end if
        pageInfo = pageInfo & " | "
   if intpage < pageCnt then
      pageInfo = pageInfo & "<a href=""" & s_url & (intpage + 1) & """>下一页</a>"
   else
         pageInfo = pageInfo & "<font color=""#CCCCCC"">下一页</font>"
        end if
        pageInfo = pageInfo & " | 转到第 <input name=""page"" type=""text"" id=""page"" style=""width:30px;heigth:20px;border:solid 1 #BBBBBB;text-align:center;"" value=""" &_
          intpage & """ maxlength=""3"" onmouseover=""this.focus()"" onfocus=""this.select()""> 页 <input type=""submit"" value=""GO"" style=""width:30px;heigth:20px;"" class=""btnGO"" onclick=""window.location.href='" &_
           s_url & "' + document.all.page.value"">"
        objrs.absolutePage = intpage
  set getPage = objrs
  End if
End Function

'获取记录集，如果有数据，把指针指向到指定页的首记录处，与getPage类似，但分页方式不同
's_count 统计记录数的SQL语句
's_command 要执行的SQL语句
'pageSize 每页显示的记录条数
'intpage 要显示第几页
's_url 页面转换的链接，如"page.asp?page="
'pageinfo 传出参数，接收页面导航的链接

Public Function getBigPage(s_count, s_command, pageSize, intpage, s_url, ByRef pageInfo)
  Dim objrs, rsCnt
  set rsCnt = executeSql(s_count)
  if rsCnt(0) > 0 then
   Dim i_start, recCnt, pageCnt
   i_start = (intpage - 1) * pageSize
   recCnt = rsCnt(0)
   set objrs = executeSql(s_command)
   objrs.move i_start
   if recCnt Mod pageSize > 0 then
    pageCnt = int(recCnt / pageSize) + 1
   else
    pageCnt = recCnt / pageSize
   End if
   if intpage < 1 then intpage = 1
   if intpage > pageCnt then intpage = pageCnt
   pageInfo = pageInfo & " 共 <font color=""#FF0000"">" & recCnt & "</font> 条记录 | <font color=""#FF0000"">" &_
     intpage & "</font>/" & pageCnt & " | "
   if intpage > 1 then
    pageInfo = pageInfo & "<a href=""" & s_url & (intpage - 1) & """>上一页</a> "
   else
          pageInfo = pageInfo & "<font color=""#CCCCCC"">上一页</font> "
         end if
         pageInfo = pageInfo & " | "
   if intpage < pageCnt then
      pageInfo = pageInfo & "<a href=""" & s_url & (intpage + 1) & """>下一页</a>"
   else
          pageInfo = pageInfo & "<font color=""#CCCCCC"">下一页</font>"
         end if
         pageInfo = pageInfo & " | 转到第 <input name=""page"" type=""text"" id=""page"" style=""width:30px;heigth:20px;border:solid 1 #BBBBBB;text-align:center;"" value=""" &_
          intpage & """ maxlength=""3"" onmouseover=""this.focus()"" onfocus=""this.select()""> 页 <input type=""submit"" value=""GO"" style=""width:30px;heigth:20px;"" onclick=""window.location.href='" &_
           s_url & "' + document.all.page.value"">"
   set getBigPage = objrs
  else
   set getBigPage = nothing
   pageInfo = pageInfo & " 共 <font color=""#FF0000"">0</font> 条记录 | <font color=""#FF0000"">" &_
     intpage & "</font>/0 | "
  End if
End Function

'清除错误信息队列
Public Sub ErrorsClear()
  ErrInfo.Clear()
End Sub

'取得错误数量
Public Property Get ErrorsCount()
ErrorsCount = ErrInfo.ErrorsCount
End Property

'取得数据数类型
Public Property Get DateType()
  DateType = m_DateBaseType
End Property

'执行SQL查询的次数
Public Property Get QueryCount()
  QueryCount = ExecuteCnt
End Property

'以列表型式显示错误信息
Public Sub PrintErr(ErrOption)
  ErrInfo.showErrors ErrOption
End Sub

'显示成功信息，并转向到指定的页面.
Public Sub showSuccAlert(s_info, changeUrl)
  Response.clear
  Response.write "<Script language=""javascript"">alert('您操作成功啦！/n/n" & s_info & "');</script>"
  If changeUrl = "CloseWindow" Then
   Response.write "<script language=""Javascript"">window.close();</script>"
   Response.end
  ElseIf Len(changeUrl) > 0 then
   Response.write "<script language=""Javascript"">window.location.href='" & changeUrl & "';</script>"
   Response.end
  End if
End Sub

'显示错误信息弹出窗口，并转向到指定页面
Public Sub showErrAlert(s_info, changeUrl)
  Response.clear
  Response.write "<Script language=""javascript"">alert('您在" & s_info & "时操作失败!/n" & Replace(ErrInfo.getErrorInfo(), "<li>", "/n ·") & "');</script>"
' & "/n/n共执行数据库查询" & QueryCount & "次;');</script>"
  if changeUrl <> "" then
   Response.write "<script language=""Javascript"">window.location.href='" & changeUrl & "';</script>"
  Else
   Response.write "<script language=""Javascript"">window.history.back();</script>"
  End if
  Response.end
End Sub

'添加一条错误信息
Public Sub AddErr(s_err)
  ErrInfo.AddItem s_err
End Sub

'析构函数
Private Sub Class_Terminate
  On Error Resume Next
  set ErrInfo = nothing
  objcn.Close
  set objcn = nothing
End Sub
End Class

'错误信息队列
Class ErrQueue
Private ErrorsQueue
Public Sub AddItem(s_Info)
  Dim i
  i = ErrorsCount
  if i = 0 then
   ReDim ErrorsQueue(1)
   ErrorsQueue(1) = s_info
  else
   ReDim Preserve ErrorsQueue(i + 1)
   ErrorsQueue(i + 1) = s_info
  End if
End Sub

Public Sub showErrors(ErrOption)
  Dim i, s_output
  i = ErrorsCount
  if i > 0 then
   Dim m
   for m = 1 to i
    s_output = s_output & "<li>" & ErrorsQueue(m) & "</li>" & vbcrlf
   Next
   ReDim ErrorsQueue(0)
   Response.Write "您在 <Font color=""#FF0000"">" & ErrOption & "</font> 时发生错误："
   Response.Write(s_output)
   Response.end
  End if
End Sub

Public Function getErrorInfo()
  Dim i
  i = ErrorsCount
  if i > 0 then
   Dim m
   for m = 1 to i
    getErrorInfo = getErrorInfo & "<li>" & ErrorsQueue(m)
   Next
   ReDim ErrorsQueue(0)
  End if
End Function

Public Property Get ErrorsCount()
  if Not isArray(ErrorsQueue) then
   ErrorsCount = 0
  else
   ErrorsCount = Ubound(ErrorsQueue)
  End if
End Property

Public Sub Clear()
ReDim ErrorsQueue(0)
End Sub

Private Sub Class_Terminate
Set ErrorsQueue = Nothing
End Sub
End Class