<%@ Language="VBScript" %> <% ' ***************************************************************************** ' ' info/ado.info6.asp ' ' GoLive design-time support for Microsoft ADO. ' ' ' ADOBE SYSTEMS INCORPORATED ' Copyright 1999-2002 Adobe Systems Incorporated. All Rights Reserved. ' ' NOTICE: Notwithstanding the terms of the Adobe GoLive End User ' License Agreement, Adobe permits you to reproduce and distribute this ' file only as an integrated part of a web site created with Adobe ' GoLive software and only for the purpose of enabling your client to ' display their web site. All other terms of the Adobe license ' agreement remain in effect. ' ----------------------------------------------------------------------------- ' Return an XML document containing information about the datasources ' in ../datasources. Valid requests are: ' ' ado.info6.asp?datasources= ' return the available datasources ' ex) .../ado.info6.asp?datasources=all ' ex) .../ado.info6.asp?datasources=distinct ' ' ado.info6.asp?getudl= ' return raw content of udl file ' ex) .../ado.info6.asp?getudl=Magazine ' ' ado.info6.asp?putudl=&data= ' writes raw content of udl file ' ex) .../ado.info6.asp?putudl=Magazine&data=blah%20blah%20blah ' ' ado.info6.asp?delete= ' deletes file ' ex) .../ado.info6.asp?delete=Magazine.udl ' ' ado.info6.asp?rename=&to= ' rename file ' ex) .../ado.info6.asp?rename=Magazine.udl&to=NewMag.udl ' ' ado.info6.asp?db= ' return global datatype information from the datasource ' ex) .../ado.info6.asp?db=Magazine ' ' ado.info6.asp?db=&types= ' return a list of tables of the given type ' ex) .../ado.info6.asp?db=Magazine&types=* ' ex) .../ado.info6.asp?db=Magazine&types=table,view ' ' ado.info6.asp?db=&sql= ' return the datatypes of the columns returned by the select ' ex) .../ado.info6.asp?db=Magazine&sql=select%20*%20from%20Projects ' ' ado.info6.asp?db=&sql=&records= ' return the results of the select ' ex) .../ado.info6.asp?db=Magazine&sql=select%20*%20from%20Projects&records=1 ' ' ado.info6.asp?db=&sql=&test= ' return the first record results of the select ' ex) .../ado.info6.asp?db=Magazine&sql=select%20*%20from%20Projects&test=whatever ' ' ado.info6.asp?db=&keys= ' return the primary key fields from a table ' ex) .../ado.info6.asp?db=Magazine&keys=Projects RejectUnauthorizedCallers Response.ContentType = "text/xml" if not RuntimeDebug then on error resume next end if if Not IsEmpty(Request("getudl")) then GetUDL Request("getudl") elseif Not IsEmpty(Request("putudl")) then PutUDL Request("putudl"), Request("data") elseif Not IsEmpty(Request("db")) then WriteDataSourceSchema Request("db") elseif (Not IsEmpty(Request("rename"))) and (Not IsEmpty(Request("to"))) then WriteDataSourceSchema Request("db") elseif IsEmpty(Request("delete")) and IsEmpty(Request("rename")) then 'this makes this the default if we don't recognize anything WriteDataSources(Request("datasources") = "all") end if ' this can appear together with any of the others if Not IsEmpty(Request("delete")) then Delete Request("delete") end if if (Not IsEmpty(Request("rename"))) and (Not IsEmpty(Request("to"))) then Rename Request("rename"), Request("to") end if if Err then WriteError end if ' ----------------------------------------------------------------------------- ' Return raw contents of UDL file sub GetUDL(baseName) set fileSystem = CreateObject("Scripting.FileSystemObject") set file = fileSystem.OpenTextFile(GetDataSourcePath() & baseName & ".udl", 1, false, -1) Response.Write file.ReadAll file.Close end sub ' ----------------------------------------------------------------------------- ' Write raw contents of UDL file sub PutUDL(baseName, data) set fileSystem = CreateObject("Scripting.FileSystemObject") set file = fileSystem.OpenTextFile(GetDataSourcePath() & baseName & ".udl", 2, true, -1) file.Write data file.Close end sub ' ----------------------------------------------------------------------------- ' Delete file from datasources folder sub Delete(fileName) set fileSystem = CreateObject("Scripting.FileSystemObject") fileSystem.DeleteFile GetDataSourcePath() & fileName, true end sub ' ----------------------------------------------------------------------------- ' Rename file from datasources folder sub Rename(fileName, newName) set fileSystem = CreateObject("Scripting.FileSystemObject") fileSystem.MoveFile GetDataSourcePath() & fileName, GetDataSourcePath() & newName end sub ' ----------------------------------------------------------------------------- ' Write out the list of available datasources. XML format: ' ' ' [...]* function WriteDataSources(all) dim fileSystem dim folder dim file dim fileName dim baseName dim prevName set fileSystem = CreateObject("Scripting.FileSystemObject") set folder = fileSystem.GetFolder(GetDataSourcePath()) Response.Write "" & vbCrLf for each file in folder.files select case ucase(fileSystem.GetExtensionName(file)) case "UDL", "DSN", "MDB", "XDB" fileName = fileSystem.GetFileName(file) baseName = fileSystem.GetBaseName(file) if all then Response.Write " " & fileName & "" & vbCrLf elseif baseName <> prevFileName then Response.Write " " & baseName & "" & vbCrLf prevName = baseName end if end select next Response.Write "" & vbCrLf end function ' ----------------------------------------------------------------------------- ' Write out the schema for a given datasource. XML format is either: ' 1. no types or sql parameters ' ex) .../ado.info6.asp?db=Magazine ' ' [ ' ... ' ... ' ... ' ... ' ]* ' ' 2. types parameter is * or comma-delimited list of table types to return ' ex) .../ado.info6.asp?db=Magazine&types=* ' ex) .../ado.info6.asp?db=Magazine&types=table,view ' ' [...]* ' ' 3. sql parameter gives a query but there is no records parameter ' ex) .../ado.info6.asp?db=Magazine&sql=select%20*%20from%20Projects ' ' [ ' ... ' ... ' ]* ' ' 4. records parameter is present (actual data, not schema information) ' ex) .../ado.info6.asp?db=Magazine&sql=select%20*%20from%20Projects&records=0 ' ' [ ' [columnvalue]* ' ]* ' ' record numbering sequential starting at 1 ' records=N,K means records from Nth to Kth inclusive ' i.e. 1,2 is 1st and 2nd ' 2,4 is 2nd, 3rd and 4th ' records=N is same as records=N,N i.e. Nth record only ' records=1,X where X is very large gets all records. ' ' 5. test parameter is present (actual data, not schema information) ' ex) .../ado.info6.asp?db=Magazine&sql=select%20*%20from%20Projects&test=whatever ' ' [ ' [columnvalue]* ' ]* ' return results of first record i.e. as for "record=1" above ' ' 6. keys parameter is primary key field ' ex) .../ado.info6.asp?db=Magazine&keys=Projects ' ' [...]* function WriteDataSourceSchema(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")), 0 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("DATA_TYPE", "IS_LONG", "SEARCHABLE", "LITERAL_PREFIX", "LITERAL_SUFFIX") set datatypes = connection.OpenSchema(adSchemaProviderTypes) Response.Write "" & vbCrLf while not datatypes.EOF dim typefield, value Response.Write " " & vbCrLf Response.Write " " & CInt(datatypes("DATA_TYPE").Value) if datatypes("IS_LONG").Value then Response.Write "L" Response.Write "" & vbCrLf if CInt(datatypes("SEARCHABLE").Value) = 1 then Response.Write " False" & vbCrLf else Response.Write " True" & vbCrLf end if for each typefield in typefields set field = datatypes(typefield) value = field.Value if isnull(value) then value = "" Response.Write " <" & field.Name & ">" & cstr(value) & "" & vbCrLf next Response.Write " " & vbCrLf datatypes.MoveNext wend Response.Write "" & vbCrLf end function ' ----------------------------------------------------------------------------- ' Get primary key fields function OpenKeysSchema(connection, keys) dim catalog, index, tableName tableName = keys set catalog = CreateObject("ADOX.Catalog") set catalog.ActiveConnection = connection Response.Write "" & vbCrLf for each index in catalog.Tables(tableName).Indexes if False = testIndexColumns(index) then exit for end if if index.PrimaryKey = True then dim i for i = 0 to index.Columns.Count - 1 Response.Write " " & index.Columns(i).Name & "" & vbCrLf next end if next Response.Write "" & vbCrLf end function ' ----------------------------------------------------------------------------- ' Get table names function OpenTablesSchema(connection, typesString) dim tables if typesString = "*" then set tables = connection.OpenSchema(adSchemaTables) Response.Write "" & vbCrLf while not tables.EOF Response.Write " " & tables("TABLE_NAME") & "" & vbCrLf tables.MoveNext wend Response.Write "" & vbCrLf else dim types, weparse, i, j weparse = False types = Split(typesString, ",") Response.Write "" & vbCrLf 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 " " & tables("TABLE_NAME") & "" & vbCrLf 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 " " & tables("TABLE_NAME") & "" & vbCrLf end if next tables.MoveNext wend end if Response.Write "" & vbCrLf end if end function ' ----------------------------------------------------------------------------- ' Handles schema requests from recordsets function AnalyzeRecordset(rs, depth) dim fields, field, recordsString, depthString, testString, resultName set fields = rs.Fields depthString = String(depth * 12, " ") recordsString = Request("records") resultName = "RECORDSET" if not IsEmpty(Request("test")) then recordsString = "1,1" resultName = "TESTRESULT" end if if IsEmpty(recordsString) then dim i Response.Write depthString & "" & vbCrLf for i = 0 to fields.Count - 1 set field = fields(i) Response.Write depthString & " " & vbCrLf Response.Write depthString & " " & field.Name & "" & vbCrLf Response.Write depthString & " " & field.Type if field.Attributes and &H80 then Response.Write "L" Response.Write "" & vbCrLf Response.Write depthString & " " & field.Type & "" & vbCrLf Response.Write depthString & " " & field.Attributes & "" & vbCrLf if field.Type = 136 then AnalyzeRecordset field.Value, depth + 1 end if Response.Write depthString & " " & vbCrLf next Response.Write depthString & "" & vbCrLf else dim records records = split(recordsString, ",") rs.Move records(0) - 1 Response.Write "<" + resultName + ">" & vbCrLf do Response.Write " " & vbCrLf for i = 0 to fields.Count - 1 set field = fields(i) encodedFieldValue = field.Value encodedFieldValue = encodeFieldValue(encodedFieldValue) Response.Write " " Response.Write encodedFieldValue Response.Write "" & vbCrLf next Response.Write " " & vbCrLf 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 "" & vbCrLf end if end function ' ----------------------------------------------------------------------------- ' Encode the field value for returning RECORDSETs function encodeFieldValue(value) if IsNull(value) then encodeFieldValue = "" else temp = Replace(value, "&", "&") temp = Replace(temp, """", """) temp = Replace(temp, "'", "'") temp = Replace(temp, "<", "<") encodeFieldValue = Replace(temp, ">", ">") end if end function ' ----------------------------------------------------------------------------- ' Write out an error message as XML. function WriteError dim qt qt = chr(34) Response.Write "" & vbCrLf end function %>