<%

' BEGIN USER CONSTANTS

' To just use a DSN, the format is shown on the next line:

'Const DSN_NAME = "DSN=ASP101email"

' Two other samples I used it with.  Left in as syntax examples for DSN-less connections

'Const DSN_NAME = "DBQ=C:\InetPub\wwwroot\asp101\samples\database.mdb;Driver={Microsoft Access Driver (*.mdb)};DriverId=25"

'Const DSN_NAME = "DBQ=C:\InetPub\database\donations.mdb;Driver={Microsoft Access Driver (*.mdb)};DriverId=25"

Dim DSN_NAME

DSN_NAME = "DBQ=" & Server.MapPath("db_dsn.mdb") & ";Driver={Microsoft Access Driver (*.mdb)};DriverId=25;"

Const DSN_USER = "username"

Const DSN_PASS = "password"

' Ok, I know these are poorly named constants, so sue me!

' This script can be used without actually setting up a DSN, so

' DSN_NAME as well as the other two constants should really be named

' something more generic like CONNECTION_STRING, CONNECTION_USER, and

' CONNECTION_PASS, but I did it this way without really thinking about

' it and I'm too lazy to change it now.  If it bothers you, you do it!

' END USER CONSTANTS

' BEGIN SUBS & FUNCTIONS SECTION

Sub OpenConnection

Set objDC = Server.CreateObject("ADODB.Connection")

objDC.ConnectionTimeout = 15

objDC.CommandTimeout = 30

objDC.Open DSN_NAME, DSN_USER, DSN_PASS

End Sub

Sub OpenRecordset(sType)

Dim sSqlString ' as String - building area for SQL query

Dim sCritOperator ' as String - basically "=" or "LIKE"

Dim sCritDelimiter ' as String - parameter delimiter "", "'", or "#"

Set objRS = Server.CreateObject("ADODB.Recordset")

Select Case sType

Case "ListTables" ' Open RS of the Tables in the DB

Set objRS = objDC.OpenSchema(adSchemaTables)

Case "ViewTable"  ' Open the Selected Table

Set objRS = Server.CreateObject("ADODB.Recordset")

objRS.Open "[" & sTableName & "]", objDC, adOpenForwardOnly, adLockReadOnly

Case "DrillDown"  ' Open the Recordset built by the selected options

Set objRS = Server.CreateObject("ADODB.Recordset")

' Build Our SQL Statement

sSqlString = "SELECT * FROM [" & sTableName & "]"

' If we're limiting records returned - insert the WHERE Clause into the SQL

If sCritField <> "" Then

' Figure out if we're dealinh with Numeric, Date, or String Values

Select Case iCritDataType

Case adSmallInt, adInteger, adSingle, adDouble, adDecimal, adTinyInt, adUnsignedTinyInt, adUnsignedSmallInt, adUnsignedInt, adBigInt, adUnsignedBigInt, adBinary, adNumeric, adVarBinary, adLongVarBinary, adCurrency, adBoolean

sCritOperator = "="

sCritDelimiter = ""

Case adDate, adDBDate, adDBTime, adDBTimeStamp

sCritOperator = "="

sCritDelimiter = "#"

Case adBSTR, adChar, adWChar, adVarChar, adLongVarChar, adVarWChar, adLongVarWChar

sCritOperator = "LIKE"

sCritDelimiter = "'"

End Select

sSqlString = sSqlString & " WHERE [" & sCritField & "] " & sCritOperator & " " & sCritDelimiter & sCritValue & sCritDelimiter

End If

' If we're sorting - insert the ORDER BY clause

If sSortOrder <> "none" Then

sSqlString = sSqlString & " ORDER BY [" & sSortField & "] " & sSortOrder

End If

sSqlString = sSqlString & ";"

' Open the actual Recordset using a Forward Only Cursor in Read Only Mode

objRS.Open sSqlString, objDC, adOpenForwardOnly, adLockReadOnly

End Select

End Sub

Sub CloseRecordset

objRS.Close

Set objRS = Nothing

End Sub

Sub CloseConnection

objDC.Close

Set objDC = Nothing

End Sub

Sub WriteTitle(sTitle)

Response.Write "<H2>" & sTitle & "</H2>" & vbCrLf

End Sub

Sub WriteTableHeader

Response.Write "<TABLE BORDER=1>" & vbCrLf

End Sub

Sub WriteTableRowOpen

Response.Write "<TR>" & vbCrLf

End Sub

Sub WriteTableCell(bCellIsTitle, sContents)

Response.Write vbTab & "<TD>"

If bCellIsTitle Then Response.Write "<B>"

Response.Write sContents

If bCellIsTitle Then Response.Write "</B>"

Response.Write "</TD>" & vbCrLf

End Sub

Sub WriteTableRowClose

Response.Write "</TR>" & vbCrLf

End Sub

Sub WriteTableFooter

Response.Write "</TABLE>" & vbCrLf

End Sub

' END SUBS & FUNCTIONS SECTION

' BEGIN RUNTIME CODE

'  Before I start with the run-time code, let me clear up a few things.

'  I've tried (and succeeded I think!) to keep all the actual HTML

'  formatting contained within Subs.  Hence things should be relatively

'  consistent as well as being easy to change if you say want a larger

'  border or perhaps a table background color or whatever...

'  This, along with my attempts to try and keep my sanity, have resulted

'  in a rather large proportion of Sub/Function Calls to actual code.

'  Since I'm sure this is probably confusing to many newcomers to ASP

'  and/or VB, I've attempted to preface each call with the optional

'  Call command.  Also any SUB or FUNCTION whose name starts with the

'  word "Write" is basically just an encapsulation of some variation of

'  a Response.Write command, while the remainder of the name represents

'  whatever it happens to write.

'     IE. WriteTableRowClose writes the tags used to end (or close) a table row

'  The actual HTML is (as usual) pretty vanilla flavored.  If you want

'  rocky-road or mint ting-a-ling (a marvelous piece of ice cream

'  craftsmanship I might add), you'll need to edit the Write functions.

'  Just be aware of the fact that any change to a SUB will affect ALL

'  uses of it, so check the code before you try and make a change to

'  just one cell and end up changing them all!

'  Okay enough of my rambling......Onwards to the Code!!!

Dim objDC, objRS ' DataConnection and RecordSet

Dim I ' As Integer - Standard Looping Var

Dim strTemp ' As String - Temporary area for building long strings

Dim sAction ' As String - Action String to choose what to do

Dim sTableName ' As String - ...so we know what to do it to

Dim sSortField ' As String - Field to sort by

Dim sSortOrder ' As String - ...ASC or DESC

Dim sCritField ' As String - Field for DrillDown

Dim sCritValue ' As String - ...Value to compare to

Dim iCritDataType ' As Integer - so we know how to compare

' Note to all you programmers out there!

' IE4 broke this code when my QueryString was named parameter because

' it was converting the &para to the Paragraph sign even though it was

' in the middle of a word and there was no trailing ;.  It works great

' in Netscape.  Here's another case where IE's efforts to make things

' foolproof ruined the asp code!

' Get all the parameters we'll need

sAction = Request.QueryString("action")

If sAction = "" Then sAction = "ListTables"

sTableName = Request.QueryString("tablename")

sSortField = Request.QueryString("sf")

Select Case LCase(Request.QueryString("so"))

Case "asc"

sSortOrder = "ASC"

Case "desc"

sSortOrder = "DESC"

Case Else

sSortOrder = "none"

End Select

sCritField = Request.QueryString("cf")

If Len(sCritField) = 0 Then sCritField = ""

sCritValue = Request.QueryString("cv")

iCritDataType = Request.QueryString("cdt")

If Len(iCritDataType) <> 0 And IsNumeric(iCritDataType) Then iCritDataType = CInt(iCritDataType)

' Start the actual DB work

' Code common to all choices.

Call OpenConnection

Call OpenRecordset(sAction)

Select Case sAction

Case "ShowDataConnectionProperties" ' Cool to look at but not really part of the sample!

' Fake it out so we don't have problems closing the DB

OpenRecordset("ListTables")

' Get all the DataConn Properties

For I = 0 to objDC.Properties.Count - 1

Response.Write I & " " & objDC.Properties(i).Name & ": " & objDC.Properties(I) & "<BR>" & vbCrLf

Next 'I

Case "ListTables"

Call WriteTitle("Tables")

If Not objRS.EOF Then objRS.MoveFirst

Call WriteTableHeader

Call WriteTableRowOpen

Call WriteTableCell(True, "Table Name")

Call WriteTableRowClose

Do While Not objRS.EOF

If objRS.Fields("TABLE_TYPE") = "TABLE" Then

Call WriteTableRowOpen

Call WriteTableCell(False, "<A HREF=""./db_dsn.asp?action=ViewTable&tablename=" & Server.URLEncode(objRS.Fields("TABLE_NAME")) & """>" & objRS.Fields("TABLE_NAME") & "</A>")

Call WriteTableRowClose

End If

objRS.MoveNext

Loop

Call WriteTableFooter

Case "ViewTable", "DrillDown" ' The same here but in the OpenRecordset SUB they're very different.

Call WriteTitle(sTableName)

If Not objRS.EOF Then objRS.MoveFirst

Call WriteTableHeader

Call WriteTableRowOpen

For I = 0 to objRS.Fields.Count - 1

' Build heading - the "sort by" links

' Was all on the line WriteTableCell line but I split it up for readability

' Field name for the heading

strTemp = objRS.Fields(I).Name

' Begin Anchor for the + Sign

strTemp = strTemp & " (<A HREF=""./db_dsn.asp"

' Set action

strTemp = strTemp & "?action=DrillDown"

' Set table name to current table

strTemp = strTemp & "&tablename=" & Server.URLEncode(sTableName)

' Set criteria field to whatever it currently is

strTemp = strTemp & "&cf=" & Server.URLEncode(sCritField)

' Set criteria value to whatever it currently is

strTemp = strTemp & "&cv=" & Server.URLEncode(sCritValue)

' Set criteria data type to this fields' data type

strTemp = strTemp & "&cdt=" & iCritDataType

' Set sort field to this field

strTemp = strTemp & "&sf=" & Server.URLEncode(objRS.Fields(I).Name)

' Set sort order to this ascending (hence the +)

strTemp = strTemp & "&so=asc"">+</A>"

' End Anchor for the + Sign

' Begin Anchor for the - Sign

' Next 8 lines are basically the same as above except for the sort order (so)

strTemp = strTemp & "/<A HREF=""./db_dsn.asp"

strTemp = strTemp & "?action=DrillDown"

strTemp = strTemp & "&tablename=" & Server.URLEncode(sTableName)

strTemp = strTemp & "&cf=" & Server.URLEncode(sCritField)

strTemp = strTemp & "&cv=" & Server.URLEncode(sCritValue)

strTemp = strTemp & "&cdt=" & iCritDataType

strTemp = strTemp & "&sf=" & Server.URLEncode(objRS.Fields(I).Name)

strTemp = strTemp & "&so=desc"">-</A>)"

' End Anchor for the - Sign

Call WriteTableCell(True, strTemp)

Next 'I

Call WriteTableRowClose

Do While Not objRS.EOF

Call WriteTableRowOpen

For I = 0 to objRS.Fields.Count - 1

If IsNull(objRS.Fields(I).Value) Or objRS.Fields(I).Value = "" Or VarType(objRS.Fields(I).Value)= vbNull Then

strTemp = "&nbsp;"

Else

' These set the drill down values which get passed if you click on any value

strTemp = "<A HREF=""./db_dsn.asp"

strTemp = strTemp & "?action=DrillDown"

strTemp = strTemp & "&tablename=" & Server.URLEncode(sTableName)

strTemp = strTemp & "&cf=" & Server.URLEncode(objRS.Fields(I).Name)

strTemp = strTemp & "&cv=" & Server.URLEncode(objRS.Fields(I).Value)

strTemp = strTemp & "&cdt=" & objRS.Fields(I).Type

strTemp = strTemp & "&sf=" & Server.URLEncode(sSortField)

strTemp = strTemp & "&so=" & sSortOrder & """>"

strTemp = strTemp & objRS.Fields(I).Value

strTemp = strTemp & "</A>"

End If

Call WriteTableCell(False, strTemp)

Next 'I

Call WriteTableRowClose

objRS.MoveNext

Loop

Call WriteTableFooter

End Select

' Close Data Access Objects and free DB variables

Call CloseRecordset

Call CloseConnection

' END RUNTIME CODE

%>