H4CK3R 4/hacker04/04_HACK04.ISO/src/ASP/db_dsn.asp

Text File | 2001-06-08 | 12.6 KB | 323 lines

<%
'*******************************************************
'*     ASP 101 Sample Code - http://www.asp101.com     *
'*                                                     *
'*   This code is made available as a service to our   *
'*      visitors and is provided strictly for the      *
'*               purpose of illustration.              *
'*                                                     *
'* Please direct all inquiries to [e-mail] *
'*******************************************************
%>

<!--
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
http://www.asp101.com/samples/adovbs.inc
-->
<!-- #INCLUDE FILE="./adovbs.inc" -->
<%
' 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)};"
'Const DSN_NAME = "DBQ=C:\InetPub\database\donations.mdb;Driver={Microsoft Access Driver (*.mdb)};"

Dim DSN_NAME
' 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") & ";"

Const DSN_USER = "admin"
Const DSN_PASS = ""
' 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 ¶ 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
            ' 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
            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 = " "
                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
%>
<BR>
<A HREF="./db_dsn.asp">Back to the Table List</A>