一个显示Grid的VBScript对象

是根据MS提供的代码修改而成，目前还不支持编辑，可以排序、查询、分页显示
<%@ Language=VBScript %>
<% Option Explicit %>
<%
Class classDataGrid

Private m_strSQL
Private m_strConn
Private m_strRowColor1
Private m_strRowColor2
Private m_strMode
Private m_strProcessPage
                        
Private m_strTitle
Private m_strRSName
Private m_strFindFields

Public Property Get SQL()
    SQL = m_strSQL
End Property

Public Property Let SQL(strSQL)
    m_strSQL = strSQL
End Property

Public Property Get Conn()
    Conn = m_strConn
End Property

Public Property Let Conn(strConn)
    m_strConn = strConn
End Property

Public Property Get RowColor1()
    If IsNull(m_strRowColor1) Or Len(m_strRowColor1) = 0 Then
        RowColor1 = "#ffffff"
    Else
        RowColor1 = m_strRowColor1
    End If
End Property

Public Property Let RowColor1(strRowColor1)
    m_strRowColor1 = strRowColor1
End Property

Public Property Get RowColor2()
    If IsNull(m_strRowColor2) Or Len(m_strRowColor2) = 0 Then
        RowColor2 = "#00ffff"
    Else
        RowColor2 = m_strRowColor2
    End If
End Property

Public Property Let RowColor2(strRowColor2)
    m_strRowColor2 = strRowColor2
End Property

Public Property Get Mode()
    If IsNull(m_strMode) Or Len(m_strMode) = 0 Then
        Mode = "View"
    Else
        Mode = m_strMode
    End If
End Property

Public Property Let Mode(strMode)
    If strMode <> "View" And strMode <> "Edit" Then
        Response.Write ("模式错误——只允许使用View和Edit<br>")
        Response.End
    Else
        m_strMode = strMode
    End If
End Property

Public Property Get ProcessPage()
    ProcessPage = m_strProcessPage
End Property

Public Property Let ProcessPage(strProcessPage)
    m_strProcessPage = strProcessPage
End Property

Public Property Get Title()
    If IsNull(m_strTitle) Or Len(m_strTitle) = 0 Then
        Title = "Data Grid"
    Else
        Title = m_strTitle
    End If
End Property

Public Property Let Title(strTitle)
    m_strTitle = strTitle
End Property

Public Property Get RSName()
    If IsNull(m_strRSName) Or Len(m_strRSName) = 0 Then
        RSName = "Grid"
    Else
        RSName = m_strRSName
    End If
End Property

Public Property Let RSName(strRSName)
    m_strRSName = strRSName
End Property

Public Property Get FindFields()
    FindFields = m_strFindFields
End Property

Public Property Let FindFields(strFindFields)
    m_strFindFields = strFindFields
End Property

Sub ShowDataGrid()

Dim intPageNum
Dim objConn
Dim objRS
Dim intAbs
Dim intCurrentPage
Dim intFindCol
Dim intPageSize
Dim intRow
Dim intCol
Dim i
Dim intPos
Dim intDisplayRows
Dim strSort
Dim strSortDir
Dim strLastSort
Dim strLastSortDir
Dim strColor
Dim strFind
Dim boolFind
Dim boolFound
Dim strFindFields
Dim strCurrentPage

Const adUseClient = 3
Const adOpenDynamic = 2
Const adAsyncFetchNonBlocking = &H40
Const adSearchForward = 1
Const adChar = 129
Const adVarChar = 200

If IsArray(FindFields) Then
    strFindFields = FindFields
End If

If Not IsObject(Session(RSName)) And (IsNull(SQL) Or Len(SQL) = 0) Then
    Response.Write ("你必须设置SQL属性以得到结果集<br>")
    Response.End
End If
If Not IsObject(Session(RSName)) And (IsNull(Conn) Or Len(Conn) = 0) Then
    Response.Write ("你必须设置SQL属性以连接数据库<br>")
    Response.End
End If

If Mode = "Edit" And (IsNull(ProcessPage) Or Len(ProcessPage) = 0) Then
    Response.Write ("你必须设置ProcessPage属性以运行Edit模式<br>")
    Response.End
End If

strCurrentPage = Request.ServerVariables("PATH_INFO")
If InStr(1, strCurrentPage, "/") > 0 Then strCurrentPage = Right(strCurrentPage, Len(strCurrentPage) - InStrRev(strCurrentPage, "/"))
If IsObject(Session(RSName)) And Request.QueryString("Reload") <> "Y" Then
    Set objRS = Session(RSName)
Else
    Set objConn = Server.CreateObject("ADODB.Connection")
    Set objRS = Server.CreateObject("ADODB.Recordset")
    Set Session(RSName) = objRS
    objConn.Open Conn
    objRS.CursorLocation = adUseClient
    objRS.Source = SQL
    objRS.CursorType = adOpenDynamic
    objRS.Properties("Initial Fetch Size") = 11
    Set objRS.ActiveConnection = objConn
    objRS.Open , , , , adAsyncFetchNonBlocking
    Set objRS.ActiveConnection = Nothing
    objConn.Close
End If
If Trim(Request("SortBy")) <> "" And Trim(Request("Resort")) <> "" Then
    strSort = Request("SortBy")
    intPos = InStr(2, objRS.Sort, "]")
    If intPos > 0 Then
        strLastSort = Left(objRS.Sort, intPos)
        strLastSortDir = Trim(Mid(objRS.Sort, intPos + 2))
    End If
    If Trim(strSort) <> Trim(strLastSort) Then
        strSortDir = "asc"
    Else
        If strLastSortDir = "asc" Then
            strSortDir = "desc"
        Else
            strSortDir = "asc"
        End If
    End If
    objRS.Sort = strSort & " " & strSortDir
End If
intPageSize = 10
If Trim(Request("txtPageSize")) <> "" Then
    intPageSize = Request("txtPageSize")
End If
intPageNum = Trim(Request.QueryString("PageNum"))
If (Trim(Request("lstPages")) <> "" Or intPageNum <> "") And Trim(Request("AllRecs")) = "" Then
    If intPageNum <> "" Then
        intCurrentPage = intPageNum
    Else
        intCurrentPage = Request("lstPages")
    End If
Else
    intCurrentPage = 1
End If

If Not (objRS.BOF And objRS.EOF) Then
    objRS.PageSize = intPageSize
    If CInt(intCurrentPage) > CInt(objRS.PageCount) Then
        intCurrentPage = objRS.PageCount
    End If
End If
Session("PageNum") = intCurrentPage
boolFind = False
If Trim(Request("FindCol")) <> "" And _
            Trim(Request("FindIt")) <> "" And _
            Trim(Request("find" & Request("FindCol"))) <> "" And _
            (objRS.RecordCount > objRS.PageSize) Then
    boolFind = True
    intFindCol = CInt(Request("FindCol"))
    strFind = "[" & objRS(intFindCol).Name & "] LIKE @#%" & _
                    Request("find" & intFindCol) & "%@#"
    intAbs = objRS.AbsolutePosition
    objRS.Filter = strFind
    boolFound = False
    If objRS.AbsolutePosition < 1 Then
        objRS.AbsolutePosition = intAbs
    Else
        boolFound = True
        intCurrentPage = Int(objRS.AbsolutePosition / objRS.PageSize)
        If objRS.AbsolutePosition Mod objRS.PageSize <> 0 Then
            intCurrentPage = intCurrentPage + 1
        End If
        intAbs = objRS.AbsolutePosition
        Session("PageNum") = intCurrentPage
    End If
Else
    objRS.Filter = ""
    If Not (objRS.BOF And objRS.EOF) Then objRS.AbsolutePage = intCurrentPage
End If
%>
<script language="javascript">
<% If boolFind AND NOT boolFound Then %>
window.status=@#** 字符串未找到 **@#
<% End If %>
function Refresh()
{
    document.frmReport.submit();
}

function MoveToPage(PageNumber)
{
    if (PageNumber != -1)
        {document.frmReport.lstPages[PageNumber].selected = true;}
    else
        {document.frmReport.lstPages[0].selected = true;}
    Refresh();
}

function ShowAllRecs()
{
    document.frmReport.txtPageSize.value = <%=objRS.RecordCount%>;
    document.frmReport.AllRecs.value = "yes"
    Refresh();
}

function ReSort(SortString)
{
    document.frmReport.SortBy.value = SortString;
    document.frmReport.ReSort.value = "yes";
    Refresh();
}

function DoFind(ColNum)
{
    document.frmReport.FindCol.value = ColNum;
    document.frmReport.FindIt.value = "yes";
    Refresh();
}
</script>

<center>
<hr>
<table border="0" width="100%">
    <tr>
        <td align="left">
            <b><%=Now()%></b>
        </td>
        <td align="center">
            <%=Title%>
        </td>
        <td align="right">
            <%If Not (objRS.BOF and objRS.EOF) Then%>
                <b><%= objRS.RecordCount%> 条纪录
                (共 <%=objRS.PageCount%> 页   第 <%=intCurrentPage%> 页 )</b>
            <%End If%>
        </td>
    </tr>
</table>
<hr>
<p><font style="COLOR:red; FONT-WEIGHT:bold"><%=Session("msg")%></font></p>
<%Session("msg") = ""%>
</center>

<form name="frmReport" method="post" action="<%=strCurrentPage%>">

<table cellspacing="2" cellpadding="2" border="0" width="100%">
    <tr>        
        <td align="center" nowrap>
              
            <a href="javascript:Refresh()" title="应用新的设置" onmouseover="window.status=@#刷新@#; return true" onmouseout="window.status=@#@#; return true">
            刷新</a>
              
        </td>
        <td nowrap>
             
        </td>
        <td align="center" nowrap>
              
            <a href="javascript:ShowAllRecs()" title="在一屏显示所有纪录" onmouseover="window.status=@#显示所有纪录@#; return true" onmouseout="window.status=@#@#; return true">
            显示所有纪录</a>
              
        </td>        
        <td align="right" valign="top" width="100%" nowrap>
        <%If Not (objRS.BOF And objRS.EOF) Then%>
            <b>每页
                <input type="text" size="3" name="txtPageSize" value="<%=intPageSize%>">
            条纪录  </b>
            <%If objRS.PageCount > 1 Then%>
                <b>转到第
                    
                <select size="1" name="lstPages" onChange="Refresh();">
                <%For intRow=1 To objRS.PageCount%>
                    <%If CInt(intCurrentPage) = CInt(intRow) Then%>
                        <option selected value="<%=intRow%>"><%=intRow%>
                    <%Else%>
                        <option value="<%=intRow%>"><%=intRow%>
                    <%End If%>
                <%Next%>
                </select>页</b>
            <%End If%>
        <%Else%>
            <input type="hidden" name="txtPageSize" value="<%=intPageSize%>">
        <%End If%>
        </td>
    </tr>
</table>

<%If Not (objRS.BOF and objRS.EOF) Then%>
    <table border="1" cellpadding="0" width="100%">
    <tr>
    <td>
    <table border="0" cellpadding="2" cellspacing="0" width="100%">
        <tr>
        <%For intCol = 0 To objRS.Fields.Count - 1%>
            <th nowrap valign="top" align="left">
                <b>
                <%
                If IsArray(FindFields) Then
                    boolFound = False
                    For i = 0 to UBound(strFindFields)
                        If UCase(objRS(intCol).Name) = UCase(strFindFields(i)) Then
                        %>
                            <input type="button" value="查询" onclick="javascript:DoFind(@#<%=intCol%>@#)" onmouseover="window.status=@#在<%=objRS(intCol).Name%>中查询指定字符串@#" onmouseout="window.status=@#@#">
                            <input type="text" name="find<%=intCol%>" size="5" maxlength="5" value="<%If boolFind Then Response.Write(Request("find" & intCol))%>"><br>
                        <%
                            boolFound = True
                            Exit For
                        End If
                    Next
                    If NOT boolFound Then
                        Response.Write("<br>")
                    End If
                End If
                %>
                <a href="javascript:ReSort(@#[<%=objRS(intCol).Name%>]@#)" onmouseover="window.status=@#按照<%=objRS(intCol).Name%>排序@#" onmouseout="window.status=@#@#;" title="按照<%=objRS(intCol).Name%>排序">
                <%=objRS(intCol).Name%></a></b>
            </th>
        <%Next%>
        </tr>
        <%intDisplayRows = objRS.AbsolutePosition + objRS.PageSize - 1%>
        <%For intRow = objRS.AbsolutePosition to intDisplayRows%>
            <tr>
            <%If CBool( Instr(1, CStr(intRow / 2), ".") > 0) Then
                strColor = RowColor1
            else
                strColor = RowColor2
            End If%>
            <%For intCol = 0 To objRS.Fields.count - 1%>
                <td nowrap style="background:<%=strColor%>">
                <%=objRS.Fields(intCol).value%></td>
            <%Next%>
            </tr>
            <%objRS.MoveNext%>
            <%if objRS.EOF then exit for%>
        <%Next%>
        <%            
            If objRS.RecordCount > objRS.PageSize Then
                If boolFind Then
                    objRS.AbsolutePosition = intAbs
                Else
                    If objRS.EOF Then
                        objRS.AbsolutePosition = objRS.RecordCount - objRS.PageSize
                    Else
                        objRS.AbsolutePosition = objRS.AbsolutePosition - objRS.PageSize
                    End If
                End If
            End If
        %>
    </table>
    </td>
    </tr>
    </table>

    <table border="0" cellspacing="2" cellpadding="2" align="left">
        <tr>
        <%
        If (intCurrentPage > 1)  Then%>
            <td align="center" width="55">
                <a href="javascript:MoveToPage(document.frmReport.lstPages.selectedIndex - 1)" onmouseover="window.status=@#上一页@#;" onmouseout="window.status=@#@#;" title="上一页">
                上一页</a>
            </td>
        <%End If%>
        <%
        If CInt(intCurrentPage) < CInt(objRS.PageCount) Then%>
            <td align="center" width="55">
                <a href="javascript:MoveToPage(document.frmReport.lstPages.selectedIndex + 1)" onmouseover="window.status=@#下一页@#;" onmouseout="window.status=@#@#;" title="下一页">
                下一页</a>
            </td>
        <%End If%>
        </tr>
    </table>
<%Else%>
    <center>
    <table border="0" cellpadding="2">
        <tr>
            <td align="center">
                没找到匹配的纪录。
            </td>
        </tr>
    </table>
    </center>
<%End If%>

<input type="hidden" name="SortBy" value="<%Response.Write(strSort)%>">
<input type="hidden" name="ReSort">
<input type="hidden" name="FindCol" value="<%Response.Write(intFindCol)%>">
<input type="hidden" name="FindIt">
<input type="hidden" name="AllRecs">

</form>

<%
Set objRS = Nothing

End Sub

End Class
%>


<%
Dim myDataGrid
Set myDataGrid = New classDataGrid

myDataGrid.SQL = "yoursql"
myDataGrid.Conn = "yourconnstr"
myDataGrid.RowColor1 = "silver"
myDataGrid.RowColor2 = "gray"
myDataGrid.Mode = "View"
myDataGrid.Title = "Title"
myDataGrid.RSName = "Grid"
myDataGrid.FindFields = Array("允许查询的字段1","允许查询的字段2")

myDataGrid.ShowDataGrid
%>
补充一点
Class classDataGrid到End Class一段建议放inc里面去
还有，Require Script Engine 5.0 or higher



 

原文转自：http://www.ltesting.net