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
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

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 informatio…
Have you ever needed to get an ASP script to wait for a while? I have, just to let something else happen. Or in my case, to allow other stuff to happen while I was murdering my MySQL database with an update. The Original Issue This was written…
Finding and deleting duplicate (picture) files can be a time consuming task. My wife and I, our three kids and their families all share one dilemma: Managing our pictures. Between desktops, laptops, phones, tablets, and cameras; over the last decade…

730 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