ASP that lists DB Structure

Posted on 2004-09-26
Last Modified: 2008-02-01
is the a way with an ASP to list a DB structure, al l fields with types?

Question by:pinkstonm
1 Comment
LVL 46

Accepted Solution

fritz_the_blank earned 50 total points
ID: 12156803
sample 1

<%@ Language = VBScript %>
<%Response.Buffer = True%>

<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
dim strDataPath, strConnectString , strSQL
dim objConnection, objRS, objRS2

'set connection strings for entire application
strDataPath = server.MapPath("orders.mdb")
strConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;"_
            + " Data Source= " & strDataPath & ";"_
            + " Mode=Share Deny None;User Id=admin;PASSWORD=;"

set objConnection=Server.CreateObject("ADODB.Connection")
objConnection.ConnectionTimeout = 15
objConnection.CommandTimeout =  10
objConnection.Mode = 3 'adModeReadWrite
if objConnection.state = 0 then
      objConnection.Open strConnectString
end if

Set objRS = Server.CreateObject("ADODB.Recordset")          'open recordset
objRS.ActiveConnection= objConnection                                   'set recordset connection
objRS.CursorType=1                                                       'set recordset to be able to modify information
Set objRS=objConnection.OpenSchema(20, array(Empty, Empty, sTableName, "TABLE"))     'set the recordset to display the tables in the database

Set objRS2=Server.CreateObject("ADODB.Recordset")
objRS2.ActiveConnection= objConnection
objRS2.CursorType=1                                                       'set recordset to be able to modify information

do while not objRS.EOF
      Response.Write("<TR><TH Colspan=2>Table Name: " & objRS("Table_Name") & "</TH></TR>")
      'the second recordset is so you are able to display all the fields from a specific table contained in the first recordset.. like so:

      objRS2.Open "SELECT * FROM [" & objRS("Table_Name") & "]"
      FOR i=0 to objRS2.Fields.Count-1
           Response.write("<TR><TD width=250>" & objRS2.Fields(i).Name & "</TD><TD>" & objRS2.Fields(i).type & "</TD</TR>")
if IsObject(objRS) then
     if not objRS is Nothing Then
          if objRS.state <> 0 then
          end if
          set objRS = Nothing
     end if
end if
if IsObject(objRS2) then
     if not objRS2 is Nothing Then
          if objRS2.state <> 0 then
          end if
          set objRS2 = Nothing
     end if
end if
if IsObject(objConnection) then
     if not objConnection is Nothing Then
          if objConnection.State <> 0 then
          end if
          set objConnection = Nothing
     end if
end if

sample 2

'The following fields types are available in access:
CONST dbAutoNumber     = 999
CONST dbBool          = 11
CONST dbInt          = 3
CONST dbSmallInt                     = 2
CONST dbDate          = 7
CONST dbText          = 202

DIM ReportText
ReportText = "Began database upgrade at: " & NOW & vbCrLf

FUNCTION GetSetting(Arg)
     SET fso = CreateObject("Scripting.FileSystemObject")
     SET theFile = fso.OpenTextFile("..\global.asa", 1, False)
     DO WHILE NOT (theFile.AtEndOfStream)
          LineText = theFile.ReadLine
          IF INSTR(1,LineText,Arg) > 0 THEN
               EqualPos = INSTR(1,LineText,"=")
               StartPos = EqualPos + 2
               tmp = TRIM(MID(LineText,StartPos))
               IF MID(tmp,1,1) = """" THEN
                    tmp = MID(tmp,2,LEN(tmp)-2)
               END IF
               tmp = REPLACE(tmp,"""","")
               TickPos = INSTR(1,tmp,"'")
               IF TickPos > 0 THEN
                    tmp = LEFT(tmp,TickPos-1)
               END IF
               GetSetting = TRIM(tmp)
               SET fso = NOTHING
               SET theFile = NOTHING
               EXIT FUNCTION
          END IF
     GetSetting = ""
     SET fso = NOTHING
     SET theFile = NOTHING

AccessDBPath = "..\Repro.mdb"
ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessDBPath

SUB WriteToFile(RepText)
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile("UpgradeDatabaseReport.txt", 2, True)
   f.Write RepText
   SET fso = NOTHING

Function TableExists(TableName)
     Set cat = CreateObject("ADOX.Catalog")
     cat.ActiveConnection = ConnString
     TableExists = False 'pre-initialize
     For Each objTable in cat.Tables
          If objTable.Type = "TABLE" AND objTable.Name = TableName THEN
               TableExists = True
          End If
     SET cat = NOTHING
End Function

Function ColumnExists(TableName,ColumnName)
     Set cat = CreateObject("ADOX.Catalog")
     cat.ActiveConnection = ConnString
     ColumnExists = False 'pre-initialize
     For Each objTable in cat.Tables
          If objTable.Type = "TABLE" AND objTable.Name = TableName THEN
               For Each objColumn in objTable.Columns
                    IF objColumn.Name = ColumnName THEN
                         ColumnExists = True
                         EXIT FUNCTION
                    END IF
          End If
     SET cat = NOTHING
End Function

Sub CreateTable(TableName)
     IF NOT TableExists(TableName) THEN
          'Define & open Database (catalog) and Table objects
          SET catDB = CreateObject("ADOX.Catalog")
          SET tbl = CreateObject("ADOX.Table")
          catDB.ActiveConnection = ConnString

          tbl.Name = TableName
          Set tbl.ParentCatalog = catDB

          'Add the new Table to the Tables collection of the database.
          catDB.Tables.Append tbl
          SET catDB = NOTHING
          ReportText = ReportText & "Created Table: " & TableName & vbCrLf
     END IF
End Sub

Sub AddColumnToTable(TableName,ColumnName,ColumnType,ColumnLength)
     IF NOT ColumnExists(TableName,ColumnName) THEN
          SET cat = CreateObject("ADOX.Catalog")
          SET col = CreateObject("ADOX.Column")
          cat.ActiveConnection = ConnString

          With col
              .Name = ColumnName
              IF ColumnType = 999 THEN 'AutoNumber
                    .Type = 3 'Must be Integer
                    Set .ParentCatalog = cat
                    .Properties("AutoIncrement") = True
               ELSE 'Non-AutoNumber
                    .Type = ColumnType
                    Set .ParentCatalog = cat
                    IF ColumnType <> 11 THEN
                         .Properties("Nullable") = True
                    END IF
               END IF
              IF ColumnLength > 0 THEN
                    .DefinedSize = ColumnLength
              END IF
          End With
          cat.Tables(TableName).Columns.Append col
          Set cat = Nothing
          Set col = Nothing
          ReportText = ReportText & "Created Column: " & TableName & "." & ColumnName & vbCrLf
     END IF
End Sub

SUB PopulateRolesData
     sql = " SELECT COUNT(*) AS CountRoles FROM Roles"
     SET rs = CreateObject("ADODB.Recordset")
     rs.Open sql,ConnString
     IF CINT(rs("CountRoles")) = 0 THEN
          SET cnn = CreateObject("ADODB.Connection")
          cnn.Open ConnString
          sql = ""
          sql = sql & " INSERT INTO Roles"
          sql = sql & " (RoleName,[View])"
          sql = sql & " VALUES('Guest',True)"
          cnn.Execute sql
          sql = ""
          sql = sql & " INSERT INTO Roles"
          sql = sql & " (RoleName,[View],Upload,Download,CreateFolders,[Delete],[Order],[Invite],[Print])"
          sql = sql & " VALUES('Project Administrator',True,True,True,True,True,True,True,True)"
          cnn.Execute sql
          sql = ""
          sql = sql & " INSERT INTO Roles"
          sql = sql & " (RoleName,[View],[Order])"
          sql = sql & " VALUES('User',True,True)"
          cnn.Execute sql

          SET cnn = NOTHING          
     END IF
     SET rs = NOTHING

CreateTable "BusinessCategories"
AddColumnToTable "BusinessCategories","BusinessCategoryID",dbAutoNumber,0
AddColumnToTable "BusinessCategories","BusinessCategory",dbText,75

CreateTable "EmailNotify"
AddColumnToTable "EmailNotify","NotifyID",dbAutoNumber,0
AddColumnToTable "EmailNotify","Email",dbText,255
AddColumnToTable "EmailNotify","Path",dbText,255
AddColumnToTable "EmailNotify","Recursive",dbBool,0

CreateTable "Faxes"
AddColumnToTable "Faxes","FaxID",dbAutoNumber,0
AddColumnToTable "Faxes","FaxType",dbText,25
AddColumnToTable "Faxes","UserID",dbInt,0
AddColumnToTable "Faxes","eFaxAddress",dbText,50
AddColumnToTable "Faxes","FaxDate",dbDate,0

[etc. . .]

ReportText = ReportText & "Completed database upgrade at: " & NOW & vbCrLf
WriteToFile ReportText
MsgBox "Database has been upgraded for ReproCentral " & appVersion & "." & vbCrLf & "View UpgradeDatabaseReport.txt for details."


Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I have helped a lot of people on EE with their coding sources and have enjoyed near about every minute of it. Sometimes it can get a little tedious but it is always a challenge and the one thing that I always say is:  The Exchange of information …
I would like to start this tip/trick by saying Thank You, to all who said that this could not be done, as it forced me to make sure that it could be accomplished. :) To start, I want to make sure everyone understands the importance of utilizing p…
This Micro Tutorial hows how you can integrate  Mac OSX to a Windows Active Directory Domain. Apple has made it easy to allow users to bind their macs to a windows domain with relative ease. The following video show how to bind OSX Mavericks to …
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

920 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now