dcsimg
<%  Option Explicit  %>

<%
    Dim sMDB, sTable, sSQL, sConn, cnnDBS, rsData, fld
    Dim sOut, sErr, sList, sWhere, sTableList, sLast
    
' ////////////////////////////////////////////////////////////////////////////////
' Identify name of database file.  Enter the name and path of the database
' file.  Must be accessable from the IIS app and folder needs to have the
' permissions granted to IUSR_MachineName user.
'
    ' Path to database
    sMDB = "C:\Inetpub\wwwroot\ShowMeTheTable\SLM.mdb"
    
    ' Open the database connection that will be used from here on out.
    Set cnnDBS = server.CreateObject("adodb.connection")
    sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sMDB
    cnnDBS.Open sConn 

    ' If there is an error connecting to data, then display and exit
    If Err.number <> 0 Then 
        sErr = "<br> <br> <br><center><font color=red><b>ERROR:  " & _
               "Assign WRITE permissions to Web Folder containing mdb file." & _
               " <br> <br>" & Err.Description  & "</b></font></center>"
        Response.Write sErr
        Response.End
    End If

    ' Instantiate the recordset object that will be used from here on out.
    Set rsData = server.CreateObject("adodb.recordset")
'
' /////////////////////////////////////////////////////////////////////////////
    
' /////////////////////////////////////////////////////////////////////////////
' Collect parameters passed via the Request object.  These will be used to
' identify the table to use, and which group (page) of records to display.
'
    ' If table is missing, load MSysObjects to list available tables
    sTable = Request("cboTable")
    If sTable = "" Then sTable = "MSysObjects"
    
        
    ' Check for a WHERE clause and if the Keyword is missing, add it.
    sWhere = Request("txtWhere")
    If sWhere <> "" And LCase(Left(sWhere,5)) <> "where" Then 
        sWhere = "WHERE " & sWhere
    End If
    
    ' The querystring variable, last, refers to the last queried table.
    ' If the current table requested is different from the Last, then
    ' clear out the WHERE clause to avoid an error.  This will cause it
    ' to be cleared for the first run, but it's better than an error.
    sLast = Request("last") & ""
    If sLast <> sTable Then sWhere = ""
'
' /////////////////////////////////////////////////////////////////////////////

%>

<HTML>
<HEAD> <TITLE>Show Me The Table</TITLE> </HEAD>
<BODY>
<FORM method= postaction=ShowMeTheTable.asp?last=<%=sTable%> id=frmDemo name=frmDemo>
    <!--  The top talble displays a list of available tables             -->< /FONT>
                           
    <table border=1 width=100% cellspacing=0 bgcolor=lightblue ID=tblData>
      <tr><th colspan= 6>Available Tables 
<a href="ShowMeTheTable.zip"><font size= 2>(download source code here)</font></a> </th></tr> <%=AvailableTablesList()%> </table> <br> <!-- Display the selected table, where option and submit button --> <table border=1 width=100% cellspacing=0 bgcolor=lightgreen ID=tblData> <tr><th> <%=sTable%> </th> <th>  WHERE and ORDER BY Clause   <INPUT type="text" id=txtWhere name=txtWhere style= "WIDTH: 300px"value="<%=sWhere%>">    <INPUT type="submit" value="Query" id=Requery name=Requery> </th> <th> Select Table:  <%=sTableList%> </th> </th></tr> </table> <br> <!-- The bottom table displays the results from the data fetch --> <table border=1 width=100% cellspacing=0 bgcolor=lightyellow ID=tblData> <%=LoadTable()%> </table> </FORM> </BODY> </HTML>
<% ' -- VB Script Code Functions -- ' ///////////////////////////////////////////////////////////////////////////// Function AvailableTablesList() ' ' This function looks up the list of available Tables (or Queries) from ' the Access MSysObjects table and displays them in the page header. It ' also creates an HTML SELECT control (drop-down box) from which users ' may select a table to view. ' Dim iCols, iCurr, sValue, sSelect iCurr = 0 iCols = 6 sList = "<tr>" ' The sTableList variable is used to build the HTML SELECT control. sTableList = "<SELECT id=cboTable name=cboTable>" ' MSysObjects is the first item in the SELECT list. sTableList = sTableList & "<OPTION" & sSelect & "MSysObjects</OPTION>" ' Retrieve a list of available tables (excluding all MSys tables except ' MSysObjects) to be used to populate the HTML SELECT control. ' (Set [Type]=1 to retrieve TABLES, [Type]=5 to retrieve QUERIES) sSQL = "SELECT [Name] FROM MSysObjects WHERE [Type]=1 AND " & _ "(Left([Name],4) <> 'Msys' OR [Name]='MSysObjects') " & _ "ORDER BY [Name]" Set rsData = cnnDBS.Execute(sSQL) ' Loop through list of table names and build HTML objects. Do Until rsData.EOF ' This section builds the list of available tables that displays at ' the top of the ASP page. The variable, iCols determines how many ' values to display before wrapping to the next row. If iCurr Mod iCols = 0 Then sList = sList & "</tr><tr>" sValue = rsData.Fields("Name") ' The variable sList adds a <TD> cell for each table in the list sList = sList & "<td align=center> [" & sValue & "] </td>" ' The SELECTED keyword identifies the currently selected option. If sValue = sTable Then sSelect = " SELECTED>" Else sSelect = ">" sTableList = sTableList & "<OPTION" & sSelect & sValue & "</OPTION>" rsData.MoveNext iCurr = iCurr + 1 Loop ' Close out the HTML SELECT Control. The variable, sTableList, is now ready ' to be plugged into the HTML to display the combo box. sTableList = sTableList & "</SELECT>" ' Pad out the table with spaces so the table borders paint consistently Do Until iCurr Mod iCols = 0 sList = sList & "<td> </td>" iCurr = iCurr + 1 Loop sList = sList & "</tr>" Set rsData = Nothing AvailableTablesList = sList End Function ' ///////////////////////////////////////////////////////////////////////////// ' /////////////////////////////////////////////////////////////////////////////
Function LoadTable() ' This function does the work of retrieving the data and converting it into ' an HTML table with column headers. It handles the case of MSysObjects ' differently,returning only the ID, Name and DateCreate fields. For all ' other tables, all rows are displayed. ' Dim lCount, sValue, sCurrVal, strHead, iColSpan, sFont ' The default table is MSysObjects, displays the list of available tables. If sTable = "MSysObjects" Then sSQL = "SELECT [ID], [Name], [DateCreate] FROM MSysObjects " & _ "WHERE [Type]=1 AND [Name] NOT LIKE 'Msys%' ORDER BY [Name]" Else ' If a WHERE clause is supplied, use it. Otherwise return 100 records. '(The WHERE clause is loaded up above, where input parameters are read.) If sWhere <> "" Then sSQL = "SELECT * FROM [" & sTable & "] " & sWhere Else sSQL = "SELECT TOP 100 * FROM [" & sTable & "] " & sWhere End If End If Set rsData = cnnDBS.Execute(sSQL) ' Loop through the fields to extract and format their field names for the ' header row. Use it as the second row, after displaying the SQL used. strHead = "<tr>" For Each fld In rsData.Fields sValue = ConvertToLabel(fld.Name) strHead = strHead & "<th>  " &sValue & "  </th>" iColSpan = iColSpan + 1 Next strHead = strHead & "</tr>" ' TABLE FIRST ROW: Reformat and display the SQL used for the fetch. sFont = "<font face='courier new' size=2 color=navy>" sOut = sOut & "<tr><td colspan=" & iColSpan & ">  " & sFont & _ "SQL = " & sSQL & "</font></td></tr>" & strHead ' TABLE SECOND ROW: Column headers for output data table. sOut = sOut & strHead ' TABLE DATA ROWS: Loop through the data rows and build the table. ' Return the result. Do Until rsData.EOF sOut = sOut & "<tr>" For Each fld In rsData.Fields sCurrVal = fld.Value & "" If sCurrVal = "" Then sCurrVal = " " sOut = sOut & "<td>" & sCurrVal & "</td>" Next sOut = sOut & "</tr>" rsData.MoveNext Loop Set rsData = Nothing Set cnnDBS = Nothing LoadTable = sOut End Function ' ///////////////////////////////////////////////////////////////////////////// ' ///////////////////////////////////////////////////////////////////////////// Function ConvertToLabel(sFieldName) ' This function simply modifies a string variable (sFieldName) and adds ' a space in front of each capital letter it finds (exception: ID). ' ' Thus, a field name is effectively converted into a column head label ' Dim iPos, iLen, sChar, sLabel, iASC sFieldName = Replace(sFieldName, "_", " ") iLen = Len(sFieldName) For iPos = 0 To iLen - 1 sChar = Mid(sFieldName, iPos + 1, 1) iASC = Asc(sChar) If iASC >= 65 and iASC <= 90 Then sLabel = sLabel & " " & sChar Else sLabel = sLabel & sChar End If Next sLabel = Replace(sLabel,"I D","ID") ConvertToLabel = sLabel End Function ' ///////////////////////////////////////////////////////////////////////////// %>