ASP数据岛类

<%
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'            Programming By Smartpig                              '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Class TBGrid

    public DataSource                '数据源
    public style                     '表格总风格
    public HeadStyle                 '表头风格
    public HeadItemStyle             '表头单独风格
    public itemStyle                 '单元格独立网络
 public HeadSort      '表头是否显示排序功能
    public Columns                   '需要显示的列元素
    public Alternate                 '是否交替风格
    public AlternateStyle            '偶数行风格
    public NormalStyle               '正常风格
    public DefaultStyle              '默认风格簇
    public PageSize                  '页大小
    public AllowPageing              '是否分页
    public PageingStyle              '页数风格
   
    Private Templates                '自定义单元项
    private CurPage                   '当前页
 private PageStart     '页面开始运行时间
   
    '内容之间的关系
    'Columns.add "Field","HeadText"
    'AddTemplate("HeadText",Template)
    'itemStyle.add "Field","style:adsasd"
 'HeadSort.add "Field",True
    'DataSource(Columns.Keys(i))
   
    Private Sub Class_Initialize   ' 设置 Initialize 事件。
        Set itemStyle  = CreateObject("Scripting.Dictionary")
  Set HeadSort  = CreateObject("Scripting.Dictionary")
        Set HeadItemStyle = CreateObject("Scripting.Dictionary")
        Set Columns   = CreateObject("Scripting.Dictionary")
        Set Templates  = CreateObject("Scripting.Dictionary")
        Set DataSource  = CreateObject("ADODB.Recordset")
        Alternate   = 0
  PageStart = Timer
    End Sub
   
    Private Sub Class_Terminate   ' 设置 Terminate 事件。
        Set itemStyle  = Nothing
  Set HeadSort  = Nothing
        Set HeadItemStyle = Nothing
        Set Columns   = Nothing
        Set DataSource  = Nothing
    End Sub
   
    Private Sub InitTable()
        'Set FieldsNum    = DataSource.Fields.Count
        'Set RowsNum     = DataSource.RecordCount
        if Columns.Count = 0 then
            For i = 0 to DataSource.Fields.Count -1
                Columns.add DataSource.Fields(i).Name,DataSource.Fields(i).Name
                response.Write(DataSource.Fields(i).Name)
            Next
        end if
       
        if IsEmpty(Style) and IsEmpty(NormalStyle) then
            DefaultStyle = 1
  Else
   DefaultStyle = Style
        end if
   
  CurPage = CInt(Request.QueryString("page"))
        if CurPage = "" then
   CurPage = 1
  End If
     
        if PageSize = Empty then
            PageSize = 10
        end if
       
        select Case DefaultStyle
            Case 1
                Style     ="align=center border=0 cellpadding=4 cellspacing=1 bgcolor='#cccccc'"
                Alternate    = 1
                HeadStyle    = "Height=25 style=""background-color:#006699;color:#ffffff"""
                AlternateStyle   = "bgColor=#ffffff height=25"
                NormalStyle    = "height=25 bgcolor=#f5f5f5"
    AllowPageing   = true
    tbGrid1.PageingStyle = "bgcolor='#f5f5f5' align='right'"
   Case 2
                Style     ="align=center border=0 cellpadding=4 cellspacing=1 bgcolor='#cccccc'"
                Alternate    = 0
                HeadStyle    = "Height=25 style=""background-color:#ffffff"""
                AlternateStyle   = "bgColor=#ffffff height=25"
                NormalStyle    = "height=25 bgcolor=#ffffff"
            Case Else
        End Select
               
    End sub
   
    public Sub AddTemplate(ByVal ColumnName,ByVal Template)
        Columns.add ColumnName,ColumnName
        Templates.add ColumnName,Template
    End Sub

    public Sub Show()
        InitTable()
       
        Dim tableStr
        Dim tdStart,tdEnd,tbStyle,tbContent
        Dim curRow
        Dim clm
        Dim regEx,Match,Matches
          
        tableStr = "<table "&style&">" & vbCrLF
       
        'Draw Table Head
        Response.Write(tableStr)
        Response.Write("<tr>")
        for Each clm in Columns.Keys()
            tbStyle = HeadStyle & " " & HeadItemStyle(clm)
            tdStart = "<th "&tbStyle&">"
            tdEnd = "</th>" & vbCrLf
           
            Response.Write(tdStart)
   '加入表头排序功能
   'Code by Redsun
   'Date:2005-1-17
   If HeadSort(clm) Then
    Response.Write Sort(clm,Columns(clm))
   Else
    Response.Write(Columns(clm))
   End If
            Response.Write(tdEnd)
        Next
        Response.Write("</tr>" & vbCrLF)
       
        'Draw Table items
        curRow = 1
        if AllowPageing <> Empty then
            DataSource.PageSize = PageSize
        else
            DataSource.PageSize = DataSource.RecordCount
        end if
       
        if CurPage < 1 then
            DataSource.AbsolutePage = 1
        end if
       
         if CurPage >= DataSource.PageCount then
            DataSource.AbsolutePage = DataSource.PageCount
        end if
       
        if CurPage >= 1 and CurPage <= DataSource.PageCount then
            DataSource.AbsolutePage = CurPage
        end if

        for curRow = 1 to DataSource.PageSize
            if DataSource.EOF then
                Exit For
            end if
                       
            Response.Write("<tr>")
            for Each clm in Columns.Keys()
                if Alternate = 0 then
                    tbStyle = NormalStyle & " " & ItemStyle(clm)
                else
                    if curRow mod 2 = 0 then
                        tbStyle = AlternateStyle & " " & ItemStyle(clm)
                    else
                        tbStyle = NormalStyle & " " & ItemStyle(clm)
                    end if
                end if
               
                tdStart = "<td "&tbStyle&">"
                tdEnd = "</td>" & vbCrLf
               
                if Templates(clm) = Empty then
                    tbContent = DataSource(clm)
                else
                    tbContent = Templates(clm)
                    Set regEx = New RegExp
                    regEx.Pattern= "{[A-Za-z0-9_-]+}"
                    regEx.IgnoreCase = True
                    regEx.Global = True
                    Set Matches=regEx.Execute(Templates(clm))
                    For each match in matches
                        On Error Resume Next
                        tbContent = Replace(tbContent,Match.Value,DataSource(Mid(Match.Value,2,Len(Match.Value)-2)),1)
                    Next
                                       
                end if
           
                Response.Write(tdStart)
                Response.Write(tbContent)
                Response.Write(tdEnd)
            Next
            Response.Write("</tr>" & vbCrLF)
           
            DataSource.MoveNext
        Next
       
        'Draw Pageing Row
        if DataSource.PageCount > 1 and LCase(pageingStyle) <> "none" then
            Dim i,EndPage,StartPage
            response.write("<tr>")
            response.write("<td colspan=" & Columns.Count & " " & PageingStyle & ">")
   '改进分页功能
   'Code by Redsun
   'Date:2005-1-17
   If CurPage>4 Then
    If CurPage+2<DataSource.PageCount Then
     StartPage = CurPage-2
     EndPage = CurPage+2
    Else
     StartPage = DataSource.PageCount-4
     EndPage = DataSource.PageCount
    End If
   Else
    StartPage = 1
    If DataSource.PageCount>5 Then
     EndPage = 5
    Else
     EndPage = DataSource.PageCount
    End If
   End If
   If CurPage>1 Then
    Response.Write "<a title='首页' href='"&GetUrl("page")&"page=1'><font face=webdings>9</font></a> "
    Response.Write "<a title='上页' href='"&GetUrl("page")&"page="&CurPage-1&"'><font face=webdings>3</font></a> "
   Else
    Response.Write "<font face=webdings>9</font> "
    Response.Write "<font face=webdings>3</font> "
   End If 
            For i=StartPage to EndPage
                if i <> CurPage then
                    response.write("<a title='第"&i&"页' href='"&GetUrl("page")&"page="&i&"'>"&i&"</a> ")
    Else
     response.write("<b>"&i&"</b> ")
                End if
            next
   If CurPage<DataSource.PageCount Then
    Response.Write "<a title='下页' href='"&GetUrl("&page&")&"page="&CurPage+1&"'><font face=webdings>4</font></a> "
     Response.Write "<a title='尾页' href='"&GetUrl("&page&")&"page="&DataSource.PageCount&"'><font face=webdings>:</font></a> "
   Else
    Response.Write "<font face=webdings>4</font> "
     Response.Write "<font face=webdings>:</font> "
   End If
   Response.Write " &nbsp;&nbsp;[共"&DataSource.RecordCount&"条]　["&PageSize&"条/页]　[共"&DataSource.PageCount&"页]"
   Response.Write " PageExecute："&Round((Timer-PageStart)*1000,2)&" MS"
   response.write("</td></tr>" & vbCrLf)
        End if
       
        'Draw Table end
        Response.Write("</table>")
       
    End sub

 '====================================================================
 '获取当前Url参数的函数
 'Codeing by Redsun
 '====================================================================
 Private Function GetUrl(RemoveList)
  Dim ScriptAddress, M_ItemUrl, M_item
  ScriptAddress = CStr(Request.ServerVariables("SCRIPT_NAME"))&"?"'取得当前地址
  M_ItemUrl = ""
  For Each M_item In Request.QueryString
   If InStr(RemoveList,M_Item)=0 Then
    M_ItemUrl = M_ItemUrl & M_Item &"="& Server.URLEncode(Request.QueryString(""&M_Item&"")) & "&"
   End If
  Next
  GetUrl = ScriptAddress & M_ItemUrl
 End Function

 '=============================
 '实现列表排序
 '返回Url参数并动态改变排序方式
 '参数：需要进行排序的字段名,显示的名称
 '=============================
 Private Function Sort(SortStr,DispName)
  If SortStr = "" Or DispName="" Then Exit Function
  Sort = GetUrl("SOrder,SSort")
  SSort = UCase(Request.QueryString("SSort"))
  If SSort = "DESC" Then
   SSort = "ASC"
  Else
   SSort = "DESC"
  End If
  Sort = "<a class='headhref' href='"&Sort&"SOrder="&SortStr&"&SSort="&SSort&"'>"&DispName&SortType(SortStr)&"</a>"
 End Function

 '-----------------------------------------------
 '标识排序列为升序还是降序方式
 '参数：排序列字段名称
 '-----------------------------------------------
 Private Function SortType(FieldName)
  Dim SOrderName
  SOrderName = Request.QueryString("SOrder")
  If SOrderName<>FieldName Then Exit Function
  Dim SSortImg
  SSortImg = Request.QueryString("SSort")
  SortType = "<img src='/OrderFormSystem/images/"&SSortImg&".gif' border='0'>"
 End Function

End Class

'users Like { UserID,LoginName,Password,RealName,Age,Gender,}
'initDB
'Rs.Open "Select * from users",Cn
'Dim tbGrid1
'Set tbGrid1 = New TBGrid
'Set tbGrid1.DataSource = Rs
'tbGrid1.Columns.add "LoginName","用户名"
'tbGrid1.HeadSort.add "LoginName",True
'tbGrid1.Columns.add "Password","密码"
'tbGrid1.AddTemplate "修改","<a href='aaa.asp?id={UserID}'><font color=red>{RealName}</font></a>"
'tbGrid1.ItemStyle.add "Password","align=right"
'tbGrid1.ItemStyle.add "修改","width=100"
'tbGrid1.PageSize = 5
'tbGrid1.AllowPageing = true
'tbGrid1.PageingStyle = "align=right"
'tbGrid1.Show()
'CloseDB
%>

 完整代码下载