home *** CD-ROM | disk | FTP | other *** search
- <!-- #INCLUDE FILE="../include/utils.runtime5.asp" -->
- <!-- #INCLUDE FILE="../include/ado.runtime5.asp" -->
-
- <script runat="server" language="VBScript">
-
- ' *****************************************************************************
- '
- ' info/ado.info5.asp
- '
- ' Dynamic Link design time support for Microsoft ADO.
- '
- '
- ' COPYRIGHT (c) 1999-2000 Adobe Systems Incorporated. All rights reserved.
-
- ' -----------------------------------------------------------------------------
- ' Return an XML document containing information about the databases
- ' in ../databases. Valid requests are:
- '
- ' ado.info5.asp return the available databases
- ' ex) http://localhost/golive/config/info/ado.info5.asp
- ' ado.info5.asp?db=<name> return schema information about a given database
- ' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine
-
- RejectUnauthorizedCallers
- Response.ContentType = "text/xml"
- if False = RuntimeDebug then
- on error resume next
- end if
-
- if IsEmpty(Request("db")) then
- WriteDatabases
- else
- WriteDatabaseSchema Request("db")
- end if
-
- if Err then
- WriteError
- end if
-
- ' -----------------------------------------------------------------------------
- ' Write out the list of available databases. XML format:
- '
- ' <DATABASES>
- ' [<DATABASE>...]*
-
- function WriteDatabases
-
- dim fileSystem
- dim folder
- dim file
- dim fileName
- dim prevFileName
-
- set fileSystem = CreateObject("Scripting.FileSystemObject")
- set folder = fileSystem.GetFolder(GetDatabasePath())
-
- Response.Write "<DATABASES>" & vbNewLine
- for each file in folder.files
- select case ucase(fileSystem.GetExtensionName(file))
- case "UDL", "DSN", "MDB", "XDB"
- fileName = fileSystem.GetBaseName(file)
- if fileName <> prevFileName then
- Response.Write " <DATABASE>" & fileName & "</DATABASE>" & vbNewLine
- prevFileName = fileName
- end if
- end select
- next
- Response.Write "</DATABASES>" & vbNewLine
-
- end function
-
- ' -----------------------------------------------------------------------------
- ' Write out the schema for a given database. XML format is either:
- ' 1. no types or sql parameters
- ' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine
- ' <DATATYPES>
- ' [<DATATYPE>
- ' <TYPE_NAME>...
- ' <DATA_TYPE>...
- ' <IS_LONG>...
- ' <SEARCHABLE>...
- ' <LITERAL_PREFIX>...
- ' <LITERAL_SUFFIX>...]*
- '
- ' 2. types parameter is * or comma-delimited list of table types to return
- ' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine&types=*
- ' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine&types=table,view
- ' <TABLES>
- ' [<TABLE>...]*
- '
- ' 3. sql parameter gives a query but there is no records parameter
- ' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine&sql=select%20*%20from%20Projects
- ' <COLUMNS>
- ' [<COLUMN>
- ' <COLUMN_NAME>...
- ' <DATA_TYPE>...
- ' <ATTRIBUTES>...]*
- '
- ' 4. records parameter is present (actual data, not schema information)
- ' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine&sql=select%20*%20from%20Projects&records=0
- ' <ROWSET>
- ' [<ROW>
- ' [<fieldname>fieldvalue</fieldname>]*]*
-
- ' 5. keys parameter is primary key field
- ' ex) http://localhost/golive/config/info/ado.info5.asp?db=Magazine&keys=Projects
- ' <KEYS>
- ' [<PRIMAY_KEY>....
-
- function WriteDatabaseSchema(db)
-
- dim connection
-
- set connection = CreateObject("ADODB.Connection")
- connection.Open ConnectString(db)
-
- if IsEmpty(Request("sql")) then
- DoOpenSchema connection
- else
- AnalyzeRecordset connection.Execute(Request("sql"))
- end if
-
- end function
-
- ' -----------------------------------------------------------------------------
- ' Handles schema requests that need OpenSchema
-
- function DoOpenSchema(connection)
-
- if IsEmpty(Request("keys")) then
- if IsEmpty(Request("types")) then
- OpenTypesSchema connection
- else
- OpenTablesSchema connection, Request("types")
- end if
- else
- OpenKeysSchema connection, Request("keys")
- end if
-
- end function
-
- ' -----------------------------------------------------------------------------
- ' Get provider types
-
- function OpenTypesSchema(connection)
-
- dim datatypes, typefields, field
-
- typefields = Array("TYPE_NAME", "DATA_TYPE", "IS_LONG", "SEARCHABLE", "LITERAL_PREFIX", "LITERAL_SUFFIX")
-
- set datatypes = connection.OpenSchema(adSchemaProviderTypes)
-
- Response.Write "<DATATYPES>" & vbNewLine
- while not datatypes.EOF
- dim typefield
-
- Response.Write " <DATATYPE>" & vbNewLine
-
- for each typefield in typefields
- set field = datatypes(typefield)
- value = field.Value
- if value = "null" then value = ""
- Response.Write " <" & field.Name & ">" & value & "</" & field.Name & ">" & vbNewLine
- next
-
- Response.Write " </DATATYPE>" & vbNewLine
-
- datatypes.MoveNext
- wend
- Response.Write "</DATATYPES>" & vbNewLine
-
- end function
-
- ' -----------------------------------------------------------------------------
- ' Get primary key fields
-
- function OpenKeysSchema(connection, keys)
- dim catalog, index
- tableName = keys
-
- set catalog = CreateObject("ADOX.Catalog")
- set catalog.ActiveConnection = connection
-
- Response.Write "<KEYS>" & vbNewLine
- for each index in catalog.Tables( tableName ).Indexes
- if False = testIndexColumns( index ) then
- exit for
- end if
- if index.PrimaryKey = True then
- for i = 0 to index.Columns.Count - 1
- Response.Write " <PRIMARY_KEY>" & index.Columns(i).Name & "</PRIMARY_KEY>" & vbNewLine
- next
- end if
- next
- Response.Write "</KEYS>" & vbNewLine
-
- end function
-
- ' -----------------------------------------------------------------------------
- ' Get table names
-
- function OpenTablesSchema(connection, typesString)
-
- dim tables
-
- if typesString = "*" then
- set tables = connection.OpenSchema(adSchemaTables)
- Response.Write "<TABLES>" & vbNewLine
- while not tables.EOF
- Response.Write " <TABLE>" & tables("TABLE_NAME") & "</TABLE>" & vbNewLine
- tables.MoveNext
- wend
- Response.Write "</TABLES>" & vbNewLine
- else
- dim types, weparse, i, j
- weparse = False
-
- types = Split(typesString, ",")
-
- Response.Write "<TABLES>" & vbNewLine
- on error resume next
-
- for i = LBound(types) to UBound(types)
- set tables = connection.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, types(i)))
- if Err then
- we parse = True
- exit for
- end if
-
- while not tables.EOF
- Response.Write " <TABLE>" & tables("TABLE_NAME") & "</TABLE>" & vbNewLine
- tables.MoveNext
- wend
- next
-
- if weparse then
- set tables = connection.OpenSchema(adSchemaTables)
- while not tables.EOF
- for j = i to UBound(types)
- if types(j) = tables("TABLE_TYPE") then
- Response.Write " <TABLE>" & tables("TABLE_NAME") & "</TABLE>" & vbNewLine
- end if
- next
-
- tables.MoveNext
- wend
- end if
-
- Response.Write "</TABLES>" & vbNewLine
- end if
-
- end function
-
- ' -----------------------------------------------------------------------------
- ' Handles schema requests from recordsets
-
- function AnalyzeRecordset(rs)
-
- dim fields, field, recordsString
- set fields = rs.Fields
-
- recordsString = Request("records")
- if IsEmpty(recordsString) then
- dim i
-
- Response.Write "<COLUMNS>" & vbNewLine
-
- for i = 0 to fields.Count - 1
- set field = fields(i)
- Response.Write " <COLUMN>" & vbNewLine
- Response.Write " <COLUMN_NAME>" & field.Name & "</COLUMN_NAME>" & vbNewLine
- Response.Write " <DATA_TYPE>" & field.Type & "</DATA_TYPE>" & vbNewLine
- Response.Write " <ATTRIBUTES>" & field.Attributes & "</ATTRIBUTES>" & vbNewLine
- Response.Write " </COLUMN>" & vbNewLine
- next
-
- Response.Write "</COLUMNS>" & vbNewLine
- else
- dim records
- records = split(recordsString, ",")
- rs.Move records(0)
-
- Response.Write "<ROWSET>" & vbNewLine
-
- do
- Response.Write " <ROW>" & vbNewLine
- for i = 0 to fields.Count - 1
- set field = fields(i)
- Response.Write " <" & field.Name & ">" & field.Value & "</" & field.Name & ">" & vbNewLine
- next
- Response.Write " </ROW>" & vbNewLine
-
- if CLng(records(0)) >= CLng(records(ubound(records))) then exit do
- records(0) = records(0) + 1
- rs.MoveNext
- loop while not (rs.EOF or Err)
-
- Response.Write "</ROWSET>" & vbNewLine
- end if
-
- end function
-
- ' -----------------------------------------------------------------------------
- ' Write out an error message as XML.
-
- function WriteError
-
- dim qt
-
- qt = chr(34)
- Response.Write "<ERROR"
- Response.Write " Number=" & qt & Err.Number & qt
- Response.Write " Source=" & qt & Err.Source & qt
- Response.Write " Description=" & qt & Err.Description & qt
- Response.Write " HelpFile=" & qt & Err.HelpFile & qt
- Response.Write " HelpContext=" & qt & Err.HelpContext & qt
- Response.Write "/>" & vbNewLine
-
- end function
-
- </script>
-