ASP 101 - Active Server Pages 101 - Web06
The Place ASP Developers Go!

Please visit our partners

Windows Technology Windows Technology
15 Seconds
ASP 101
ASP Wire
VB Forums
VB Wire
internet.commerce internet.commerce
Partners & Affiliates

ASP 101 is an site
ASP 101 is an site
Internet News
Small Business
Personal Technology

Corporate Info
Tech Jobs
E-mail Offers

ASP 101 News Flash ASP 101 News Flash

ASP Source Code:
The following include file contains all the VB ADO Constants.
If you don't want to include the whole file, you can replace all
constants with their numerical equivalents and the script will work the
same way.  You could also cut and paste just the declarations you use.
We simply got tired of looking up constants since we use so many!
The file is included with VBScript so you should have it somewhere.
If you can't find it, the full path so you can download the file is
<!-- #include file="" -->
' To just use a DSN, the format is shown on the next line:
'Const DSN_NAME = "DSN=ASP101"
' 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)};"
'Const DSN_NAME = "DBQ=C:\InetPub\database\donations.mdb;Driver={Microsoft Access Driver (*.mdb)};"
' Used this ODBC connection until 11/8/99
'DSN_NAME = "DBQ=" & Server.MapPath("db_dsn.mdb") & ";Driver={Microsoft Access Driver (*.mdb)};"
' Switched to OLE DB on 11/8/99 - giving it a try
'DSN_NAME = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath("db_dsn.mdb") & ";"
' Finally moved to SQL Server...
DSN_NAME = "Provider=SQLOLEDB;Data Source=;" _
	& "Initial Catalog=samples;Connect Timeout=15;" _
	& "Network Library=dbmssocn;"
Const DSN_USER = "samples"
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!
Sub OpenConnection
	Set objDC = Server.CreateObject("ADODB.Connection")
	objDC.ConnectionTimeout = 15
	objDC.CommandTimeout = 30
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 dealing 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 = "'" ' # for Access
					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
	Set objRS = Nothing
End Sub
Sub CloseConnection
	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 "<strong>"
	Response.Write sContents
	If bCellIsTitle Then Response.Write "</strong>"
	Response.Write "</td>" & vbCrLf
End Sub
Sub WriteTableRowClose
	Response.Write "</tr>" & vbCrLf
End Sub
Sub WriteTableFooter
	Response.Write "</table>" & vbCrLf
End Sub
'  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 - 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 ¶ 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")
sAction = Replace(sAction, "'", "''")
If sAction = "" Then sAction = "ListTables"
sTableName = Request.QueryString("tablename")
sTableName = Replace(sTableName, "'", "''")
sSortField = Request.QueryString("sf")
sSortField = Replace(sSortField, "'", "''")
Select Case LCase(Request.QueryString("so"))
	Case "asc"
		sSortOrder = "ASC"
	Case "desc"
		sSortOrder = "DESC"
	Case Else
		sSortOrder = "none"
End Select
sCritField = Request.QueryString("cf")
sCritField = Replace(sCritField, "'", "''")
If Len(sCritField) = 0 Then sCritField = ""
sCritValue = Request.QueryString("cv")
sCritValue = Replace(sCritValue, "'", "''")
If Len(sCritValue) > 25 Then sCritValue = ""
iCritDataType = Request.QueryString("cdt")
iCritDataType = Replace(iCritDataType, "'", "''")
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
		' 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
			' Rule out everything but tables and don't list system tables.
			' Note MSys is only for OLEDB.
			If objRS.Fields("TABLE_TYPE") = "TABLE" AND Left(objRS.Fields("TABLE_NAME"), 4) <> "MSys" 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
		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 = " "
					' 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
		Call WriteTableFooter
End Select
' Close Data Access Objects and free DB variables
Call CloseRecordset
Call CloseConnection
<a href="./db_dsn.asp">Back to the Table List</a>

Back the the Sample Output

Back to the Sample Index

Home |  News |  Samples |  Articles |  Lessons |  Resources |  Forum |  Links |  Search |  Feedback



Jupitermedia Corporation has two divisions: Jupiterimages and JupiterOnlineMedia

Jupitermedia Corporate Info

Legal Notices, Licensing, Reprints, & Permissions, Privacy Policy.

Advertise | Newsletters | Tech Jobs | Shopping | E-mail Offers

Whitepapers and eBooks
Intel Go Parallel Portal: Interview with C++ Guru Herb Sutter
IBM Article: How Cool Is Your Data Center?
Microsoft Article: Managing Virtual Machines with Microsoft System Center
Avaya Article: How to Begin Developing with Avaya's Event Processing Language
Avaya Article: Deep Dive--Event Processor Offers Familiar Tools for Creating Event-Driven SOA Apps
Intel Whitepaper: A Methodology for Threading Serial Applications (PDF)
HP eBook: Storage Networking , Part 1 Article: Tip of the Trade--IP Address Management Article: Enterprise Fixed-Mobile Convergence Can Be Lucrative
Intel Article: Transitioning Software to Future Generations of Multi-Core
Hoovers Article: Boost Employee Morale without Breaking the Bank
Microsoft Article: Solving Data Center Complexity with Microsoft System Center Configuration Manager 2007 eBook: All About Botnets
Intel Article: 8 Simple Rules for Designing Threaded Applications
Intel Whitepaper: Best Practices for Developing and Optimizing Threaded Applications
Intel Article: The Challenges of Developing Multithreaded Processing Pipelines
Intel Video: Foundations of Parallel Programming, Part One
HP Video: Page Cost Calculator
HP Webcast: Storage Is Changing Fast - Be Ready or Be Left Behind
Intel Video: Three Must-Knows for Parallelism
Microsoft Partner Program Video: The Secrets to Partner Success
Microsoft Silverlight Video: Creating Fading Controls with Expression Design and Expression Blend 2
Downloads and eKits
Sybase Download: SQL Anywhere Developer Edition
Red Gate Download: SQL Backup Pro and free DBA Best Practices eBook
Red Gate Download: SQL Compare Pro 6
Iron Speed Designer Application Generator
Tutorials and Demos
eTouch PDF: Conquering the Tyranny of E-Mail and Word Processors
How-to-Article: How to Market Your Technology Solutions
IBM Article: Collaborating in the High-Performance Workplace
HP Demo: StorageWorks EVA4400
Microsoft How-to Article: Get Going with Silverlight and Windows Live