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

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

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

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…
This demonstration started out as a follow up to some recently posted questions on the subject of logging in: and…
Along with being a a promotional video for my three-day Annielytics Dashboard Seminor, this Micro Tutorial is an intro to Google Analytics API data.
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit If you want to manage em…

776 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