<%@ Language=VBScript %>
<%
Option Explicit
Response.Expires = 0
'On Error Resume Next
'Datenbankanbindung ohne ODBC
'geht nur, wenn auf Webserver ein Access-Treiber installiert ist!
Dim blnerstezeile
Dim objcon
Dim objfield
Dim objrs
Dim objProperty
Dim rsSchemaColumns
Dim rsSchemaPrimaryKeys
Dim rsSchemaProviderTypes
Dim strcon, strsql
Dim strColAutowert
Dim strColDataType 'Datentyp einer Spalte aus Schema, nicht gleich wie Recordset
Dim strColDefault
Dim strColIs_Nullable
Dim strColPKOrdinal
Dim strColPrefix
Dim strColSuffix
Dim strFieldAttributes
Dim strPrimaryKeys
Dim strTablename
strTablename = "tblfieldtest"
blnerstezeile = true
Set objcon = Server.CreateObject("ADODB.Connection")
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Server.MapPath("/asppages/silvi/db/dbfieldtest.mdb")
'Response.Write strcon
objcon.Open strcon
'Recordset geöffnet?
Const adStateOpen = &H00000001
'Filterkriterium
Const adFilterNone = 0
'Schema
Const adSchemaProviderSpecific = -1
Const adSchemaAsserts = 0
Const adSchemaCatalogs = 1
Const adSchemaCharacterSets = 2
Const adSchemaCollations = 3
Const adSchemaColumns = 4
Const adSchemaCheckConstraints = 5
Const adSchemaConstraintColumnUsage = 6
Const adSchemaConstraintTableUsage = 7
Const adSchemaKeyColumnUsage = 8
Const adSchemaReferentialContraints = 9
Const adSchemaTableConstraints = 10
Const adSchemaColumnsDomainUsage = 11
Const adSchemaIndexes = 12
Const adSchemaColumnPrivileges = 13
Const adSchemaTablePrivileges = 14
Const adSchemaUsagePrivileges = 15
Const adSchemaProcedures = 16
Const adSchemaSchemata = 17
Const adSchemaSQLLanguages = 18
Const adSchemaStatistics = 19
Const adSchemaTables = 20
Const adSchemaTranslations = 21
Const adSchemaProviderTypes = 22
Const adSchemaViews = 23
Const adSchemaViewColumnUsage = 24
Const adSchemaViewTableUsage = 25
Const adSchemaProcedureParameters = 26
Const adSchemaForeignKeys = 27
Const adSchemaPrimaryKeys = 28
Const adSchemaProcedureColumns = 29
'Datentypen Recordset
Const adEmpty = 0
Const adSmallInt = 2
Const adInteger = 3
Const adSingle = 4
Const adDouble = 5
Const adCurrency = 6
Const adDate = 7
Const adBSTR = 8
Const adIDispatch = 9
Const adError = 10
Const adBoolean = 11
Const adVariant = 12
Const adIUnknown = 13
Const adDecimal = 14
Const adTinyInt = 16
Const adUnsignedTinyInt = 17
Const adUnsignedSmallInt = 18
Const adUnsignedInt = 19
Const adBigInt = 20
Const adUnsignedBigInt = 21
Const adGUID = 72
Const adBinary = 128
Const adChar = 129
Const adWChar = 130
Const adNumeric = 131
Const adUserDefined = 132
Const adDBDate = 133
Const adDBTime = 134
Const adDBTimeStamp = 135
Const adVarChar = 200
Const adLongVarChar = 201
Const adVarWChar = 202
Const adLongVarWChar = 203
Const adVarBinary = 204
Const adLongVarBinary = 205
'Feldattribute
Const adFldMayDefer = &H00000002
Const adFldUpdatable = &H00000004
Const adFldUnknownUpdatable = &H00000008
Const adFldFixed = &H00000010
Const adFldIsNullable = &H00000020
Const adFldMayBeNull = &H00000040
Const adFldLong = &H00000080
Const adFldRowID = &H00000100
Const adFldRowVersion = &H00000200
'*****************************************************************
'weist einer Schema-Konstanten einen Namen zu
Function funSchemaName(ByVal intSchema)
Select Case intSchema
Case adSchemaProviderSpecific
funSchemaName = "adSchemaProviderSpecific"
Case adSchemaAsserts
funSchemaName = "adSchemaAsserts"
Case adSchemaCatalogs
funSchemaName = "adSchemaCatalogs"
Case adSchemaCharacterSets
funSchemaName = "adSchemaCharacterSets"
Case adSchemaCollations
funSchemaName = "adSchemaCollations"
Case adSchemaColumns
funSchemaName = "adSchemaColumns"
Case adSchemaCheckConstraints
funSchemaName = "adSchemaCheckConstraints"
Case adSchemaConstraintColumnUsage
funSchemaName = "adSchemaConstraintColumnUsage"
Case adSchemaConstraintTableUsage
funSchemaName = "adSchemaConstraintTableUsage"
Case adSchemaKeyColumnUsage
funSchemaName = "adSchemaKeyColumnUsage"
Case adSchemaReferentialContraints
funSchemaName = "adSchemaReferentialContraints"
Case adSchemaTableConstraints
funSchemaName = "adSchemaTableConstraints"
Case adSchemaColumnsDomainUsage
funSchemaName = "adSchemaColumnsDomainUsage"
Case adSchemaIndexes
funSchemaName = "adSchemaIndexes"
Case adSchemaColumnPrivileges
funSchemaName = "adSchemaColumnPrivileges"
Case adSchemaTablePrivileges
funSchemaName = "adSchemaTablePrivileges"
Case adSchemaUsagePrivileges
funSchemaName = "adSchemaUsagePrivileges"
Case adSchemaProcedures
funSchemaName = "adSchemaProcedures"
Case adSchemaSchemata
funSchemaName = "adSchemaSchemata"
Case adSchemaSQLLanguages
funSchemaName = "adSchemaSQLLanguages"
Case adSchemaStatistics
funSchemaName = "adSchemaStatistics"
Case adSchemaTables
funSchemaName = "adSchemaTables"
Case adSchemaTranslations
funSchemaName = "adSchemaTranslations"
Case adSchemaProviderTypes
funSchemaName = "adSchemaProviderTypes"
Case adSchemaViews
funSchemaName = "adSchemaViews"
Case adSchemaViewColumnUsage
funSchemaName = "adSchemaViewColumnUsage"
Case adSchemaViewTableUsage
funSchemaName = "adSchemaViewTableUsage"
Case adSchemaProcedureParameters
funSchemaName = "adSchemaProcedureParameters"
Case adSchemaForeignKeys
funSchemaName = "adSchemaForeignKeys"
Case adSchemaPrimaryKeys
funSchemaName = "adSchemaPrimaryKeys"
Case adSchemaProcedureColumns
funSchemaName = "adSchemaProcedureColumns"
Case Else
funSchemaName = "unbekannt"
End Select
End Function
'Setzt WHERE-Clause für PKs zusammen
'Wert lässt sich mit Join(Split.. ersetzen
Function funStrPrimaryKeys(strcon, strTablename)
Const adSchemaPrimaryKeys = 28
Dim arrKeys(5)
Dim blnFirst
blnFirst = True
Dim intCounter
Dim objcon
Dim objField
Dim rsSchema
Dim strHelp
Set objcon = Server.CreateObject("ADODB.Connection")
objcon.Open strcon
Set rsSchema = objcon.OpenSchema(adSchemaPrimaryKeys)
rsSchema.Filter = "TABLE_NAME = '" & strTablename & "'"
Do Until rsSchema.EOF
arrKeys(rsSchema("ORDINAL") - 1) = rsSchema("COLUMN_NAME")
rsSchema.MoveNext
Loop
For intCounter = 0 To 4
If arrKeys(intCounter) <> "" Then
If blnFirst Then
strHelp = " WHERE " & arrKeys(intCounter) & " = |" & arrKeys(intCounter) & "|"
blnFirst = False
Else
strHelp = strHelp & " AND " & arrKeys(intCounter) & " = |" & arrKeys(intCounter) & "|"
End If
End If
Next
funStrPrimaryKeys = strHelp
End Function
'Zeigt für die verschiedenen Schema-Konstanten Tabellen an
Sub procSchemaToTable(strcon, intSchema)
Dim objcon
Dim objfield
Dim rsSchema
Set objcon = Server.CreateObject("ADODB.Connection")
Response.Write intSchema
objcon.Open strcon
on error resume next
Set rsSchema = objcon.OpenSchema(intSchema)
If err.number = 3251 Then
response.flush
response.write " <b>" & funSchemaName(intSchema)
response.write "</b><br /> is not supported<br />"
err.clear
Else
response.write " <b>" & funSchemaName(intSchema) & "</b><br />"
response.write "<table border=""1""><tr>"
'Beschriftungen
For each objfield in rsSchema.fields
response.write "<td><b>" & objfield.name & "</b></td>"
next
response.write "</tr>"
'Felder
Do Until rsSchema.EOF
'Systemtabellen ausgenommen
If Left(rsSchema("TABLE_NAME"), 4) <> "MSys" Then
response.write "<tr>"
for each objField in rsSchema.fields
response.write "<td valign=""top"">" & Trim(objField.value) & " </td>"
next
response.write "</tr>"
End If
rsSchema.MoveNext
Loop
response.write "</table><br />"
response.flush
End If
rsSchema.Close
set rsSchema = nothing
objcon.close
set objcon = nothing
End Sub
'*****************************************************************
'Anfang <html>
%>
<!--#include virtual="asppages/silvi/_include/preheader.inc" -->
<html>
<head>
<title>ASP Datenbankanbindung: Tabellenfelder und ihre wichtigen Eigenschaften mit dem Schema auslesen
</title>
<!--#include virtual="asppages/silvi/_include/header.inc" -->
</head>
<body>
<h3>ASP Datenbankanbindung: Tabellenfelder und ihre wichtigen Eigenschaften mit dem Schema auslesen
</h3>
<p>Beispiel einer Access-DB
</p>
<%
'*****************************************************************
'Code innerhalb der HTML-Seite
Set rsSchemaColumns = objcon.OpenSchema(adSchemaColumns)
Set rsSchemaPrimaryKeys = objcon.OpenSchema(adSchemaPrimaryKeys)
Set rsSchemaProviderTypes = objcon.OpenSchema(adSchemaProviderTypes) 'Datentypen
'Primärschlüsselstring
strPrimaryKeys = funStrPrimaryKeys(strcon, strTablename)
Response.Write("PK: " & strPrimaryKeys & "<br /> <br />" & vbCrLf)
'Select
strsql = "SELECT * FROM " & strTablename
Set objrs = Server.CreateObject("ADODB.Recordset")
objrs.Open strsql, objcon, 1, 3
If IsObject(objRS) Then
If objRS.State = adStateOpen Then
Response.Write("<table border=""1"">" & vbCrLf)
If Not objRS.EOF Then
If blnerstezeile Then
Response.Write("<tr>" & vbCrLf)
'Feldname
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write("<b>Feldname</b>" & vbCrLf)
Response.Write("</td>" & vbCrLf)
'Feldtyp
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write("<b>Feldtyp</b>" & vbCrLf)
Response.Write("</td>" & vbCrLf)
'Grösse, NumericScale, Precision
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write("<b>Grösse<br />Numeric Scale<br />Precision</b>" & vbCrLf)
Response.Write("</td>" & vbCrLf)
'Feldattribute
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write("<b>Feldattribute</b>" & vbCrLf)
Response.Write("</td>" & vbCrLf)
'Eingabe- oder Anzeigefelder
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write("<b>Eingabefeld</b>" & vbCrLf)
Response.Write("</td>" & vbCrLf)
'Defaultwert
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write("<b>Defaultwert</b>" & vbCrLf)
Response.Write("</td>" & vbCrLf)
'Schlüsselfeld
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write("<b>Schlüsselfeld</b>" & vbCrLf)
Response.Write("</td>" & vbCrLf)
'Pre-/Suffix
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write("<b>Pre-/Suffix</b>" & vbCrLf)
Response.Write("</td>" & vbCrLf)
'Null erlaubt aus Schema Columns
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write("<b>Null erlaubt</b>" & vbCrLf)
Response.Write("</td>" & vbCrLf)
'Autowert
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write("<b>Autowert</b>" & vbCrLf)
Response.Write("</td>" & vbCrLf)
Response.Write("</tr>" & vbCrLf)
blnerstezeile = False
End If
'**************************************************************************
For each objField In objRS.Fields
'Column-Eigenschaften aus Schema Columns bestimmen
rsSchemaColumns.Filter = "TABLE_NAME = '" & strTablename & "' AND COLUMN_NAME = '" & objField.Name & "'"
If Not rsSchemaColumns.EOF Then
strColDataType = rsSchemaColumns("DATA_TYPE") 'für Pre-/Suffix
strColDefault = rsSchemaColumns("COLUMN_DEFAULT")
strColIs_Nullable = rsSchemaColumns("IS_NULLABLE")
Else
strColDataType = " "
strColDefault = " "
strColIs_Nullable = " "
End If
rsSchemaColumns.Filter = adFilterNone
'Primärschlüssel aus Schema PrimaryKeys
rsSchemaPrimaryKeys.Filter = "TABLE_NAME = '" & strTablename & "' AND COLUMN_NAME = '" & objField.Name & "'"
if NOT rsSchemaPrimaryKeys.EOF Then
strColPKOrdinal = rsSchemaPrimaryKeys("ORDINAL")
Else
strColPKOrdinal = " "
End If
rsSchemaPrimaryKeys.Filter = adFilterNone
'Pre- und Suffix aus Schema ProviderTypes
rsSchemaProviderTypes.Filter = "DATA_TYPE = " & strColDataType
If NOT rsSchemaProviderTypes.EOF Then
strColPrefix = rsSchemaProviderTypes("LITERAL_PREFIX")
strColSuffix = rsSchemaProviderTypes("LITERAL_SUFFIX")
Else
strColPrefix = ""
strColSuffix = ""
End If
rsSchemaProviderTypes.Filter = adFilterNone
strColAutowert = objField.Properties("ISAUTOINCREMENT")
Dim strTest
strTest = Join(Split("xuezw", "!"),"?")
If Not IsNull(objField.Value) Then
strPrimaryKeys = Join(Split(strPrimaryKeys, "|" & objField.Name & "|"), _
strColPrefix & objField.Value & strColSuffix)
End If
'******************************************************************
Response.Write("<tr>" & vbCrLf)
'Feldname
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write(objField.Name & vbCrLf)
Response.Write("</td>" & vbCrLf)
'Feldtyp
Response.Write("<td valign=""top"">" & vbCrLf)
Select Case objField.Type
Case adEmpty
Response.Write(objField.Type & " adEmpty" & vbCrLf)
Case adSmallInt
Response.Write(objField.Type & " adSmallInt" & vbCrLf)
Case adInteger
Response.Write(objField.Type & " adInteger" & vbCrLf)
Case adSingle
Response.Write(objField.Type & " adSingle" & vbCrLf)
Case adDouble
Response.Write(objField.Type & " adDouble" & vbCrLf)
Case adCurrency
Response.Write(objField.Type & " adCurrency" & vbCrLf)
Case adDate
Response.Write(objField.Type & " adDate" & vbCrLf)
Case adBSTR
Response.Write(objField.Type & " adBSTR" & vbCrLf)
Case adIDispatch
Response.Write(objField.Type & " adIDispatch" & vbCrLf)
Case adError
Response.Write(objField.Type & " adError" & vbCrLf)
Case adBoolean
Response.Write(objField.Type & " adBoolean" & vbCrLf)
Case adVariant
Response.Write(objField.Type & " adVariant" & vbCrLf)
Case adIUnknown
Response.Write(objField.Type & " adIUnknown" & vbCrLf)
Case adDecimal
Response.Write(objField.Type & " adDecimal" & vbCrLf)
Case adTinyInt
Response.Write(objField.Type & " adTinyInt" & vbCrLf)
Case adUnsignedTinyInt
Response.Write(objField.Type & " adUnsignedTinyInt" & vbCrLf)
Case adUnsignedSmallInt
Response.Write(objField.Type & " adUnsignedSmallInt" & vbCrLf)
Case adUnsignedInt
Response.Write(objField.Type & " adUnsignedInt" & vbCrLf)
Case adBigInt
Response.Write(objField.Type & " adBigInt" & vbCrLf)
Case adUnsignedBigInt
Response.Write(objField.Type & " adUnsignedBigInt" & vbCrLf)
Case adGUID
Response.Write(objField.Type & " adGUID" & vbCrLf)
Case adBinary
Response.Write(objField.Type & " adBinary" & vbCrLf)
Case adChar
Response.Write(objField.Type & " adChar" & vbCrLf)
Case adWChar
Response.Write(objField.Type & " adWChar" & vbCrLf)
Case adNumeric
Response.Write(objField.Type & " adNumeric" & vbCrLf)
Case adUserDefined
Response.Write(objField.Type & " adUserDefined" & vbCrLf)
Case adDBDate
Response.Write(objField.Type & " adDBDate" & vbCrLf)
Case adDBTime
Response.Write(objField.Type & " adDBTime" & vbCrLf)
Case adDBTimeStamp
Response.Write(objField.Type & " adDBTimeStamp" & vbCrLf)
Case adVarChar
Response.Write(objField.Type & " adVarChar" & vbCrLf)
Case adLongVarChar
Response.Write(objField.Type & " adLongVarChar" & vbCrLf)
Case adVarWChar
Response.Write(objField.Type & " adVarWChar" & vbCrLf)
Case adLongVarWChar
Response.Write(objField.Type & " adLongVarWChar" & vbCrLf)
Case adVarBinary
Response.Write(objField.Type & " adVarBinary" & vbCrLf)
Case adLongVarBinary
Response.Write(objField.Type & " adLongVarBinary" & vbCrLf)
Case Else
Response.Write(objField.Type & " nicht bestimmbar " & vbCrLf)
End Select
Response.Write("</td>" & vbCrLf)
'Grösse, NumericScale, Precision
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write(objField.DefinedSize & "<br />" & objField.NumericScale & _
"<br />" & objField.Precision & vbCrLf)
Response.Write("</td>" & vbCrLf)
'Feldattribute
strFieldAttributes = ""
Response.Write("<td valign=""top"">" & vbCrLf)
If CBool(objField.Attributes And adFldMayDefer) Then
strFieldAttributes = strFieldAttributes & " adFldMayDefer<br />"
End If
If CBool(objField.Attributes And adFldUpdatable ) Then
strFieldAttributes = strFieldAttributes & " adFldUpdatable<br />"
End If
If CBool(objField.Attributes And adFldUnknownUpdatable ) Then
strFieldAttributes = strFieldAttributes & " adFldUnknownUpdatable<br />"
End If
If CBool(objField.Attributes And adFldFixed ) Then
strFieldAttributes = strFieldAttributes & " adFldFixed<br />"
End If
If CBool(objField.Attributes And adFldIsNullable ) Then
strFieldAttributes = strFieldAttributes & " adFldIsNullable<br />"
End If
If CBool(objField.Attributes And adFldMayBeNull ) Then
strFieldAttributes = strFieldAttributes & " adFldMayBeNull<br />"
End If
If CBool(objField.Attributes And adFldLong ) Then
strFieldAttributes = strFieldAttributes & " adFldLong<br />"
End If
If CBool(objField.Attributes And adFldRowID ) Then
strFieldAttributes = strFieldAttributes & " adFldRowID<br />"
End If
If CBool(objField.Attributes And adFldRowVersion ) Then
strFieldAttributes = strFieldAttributes & " adFldRowVersion<br />"
End If
If Len(strFieldAttributes) > 2 Then
strFieldAttributes = Left(strFieldAttributes, Len(strFieldAttributes) - 6)
Response.Write(objField.Attributes & "<br />" & strFieldAttributes & vbCrLf)
End If
Response.Write(" <br /><b>Field-Properties</b><br />" & vbCrLf)
For Each objProperty In objField.Properties
Response.Write(objProperty.Name & " = " & objProperty.Value & "<br />" & vbCrLf)
Next
Response.Write(" <br />" & vbCrLf)
Response.Write(" </td>" & vbCrLf)
'Eingabe- oder Anzeigefelder
Response.Write("<td valign=""top"">" & vbCrLf)
If CBool(objField.Attributes And adFldUpdatable) Then
If objField.Name <> "Erstellungsdatum" And objField.Name <> "Mutationsdatum" Then
If objField.Type = adLongVarWChar Then
'Für Memofelder mehrzeiliges Textfeld
Response.Write("<textarea rows=""4"" name=""" & objField.Name & _
""" cols=""40"">" & objField.Value & "</textarea>" & vbCrLf)
ElseIf objField.Type = adBoolean Then
'Für boolsche Felder Kombinationsfeld
Response.Write("<select size=""1"" name=""" & objField.Name & """>" & vbCrLf & _
" <option value=""" & objField.Value & """ selected="""">" & objField.Value & "</option>" & vbCrLf &_
" <option value=""" & (Not objField.Value) & """>" & (Not objField.Value) & "</option>" & vbCrLf &_
"</select>" & vbCrLf)
Else
Response.Write("<input type=""text"" size=""40"" name=""" & objField.Name & _
""" value=""" & objField.Value & """ />" & vbCrLf)
End If
Else
Response.Write(objField.Value & " " & vbCrLf)
End If
Else
Response.Write(objField.Value & " " & vbCrLf)
End If
Response.Write("</td>" & vbCrLf)
'Defaultwert
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write(strColDefault & vbCrLf)
Response.Write(" </td>" & vbCrLf)
'Schlüsselfeld
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write(strColPKOrdinal & vbCrLf)
Response.Write(" </td>" & vbCrLf)
'Pre-/Suffix aus Schema "ProviderTypes"
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write(strColPrefix & "..." & strColSuffix & vbCrLf)
Response.Write(" </td>" & vbCrLf)
'Null erlaubt aus Schema Columns
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write(strColIs_Nullable & vbCrLf)
Response.Write(" </td>" & vbCrLf)
'Autowert
Response.Write("<td valign=""top"">" & vbCrLf)
Response.Write(strColAutowert & vbCrLf)
Response.Write(" </td>" & vbCrLf)
Response.Write("</tr>" & vbCrLf)
Next
objRS.MoveNext
End If
Response.Write("</table>" & vbCrLf)
Response.Write("PK: " & strPrimaryKeys & "<br /> <br />" & vbCrLf)
End If 'objRS.State = adStateOpen
End If 'IsObject(objRS)
objrs.Close
Set objrs = Nothing
%>
<!--#include virtual="asppages/silvi/_include/inchtmlnachspann.asp" -->
</body>
</html>
Demo: beispiele/060dbohneodbcfieldattributes2.asp
Letzter Update:
26.12.2021 16:48
Zurück zur
Liste mit ASP-Beispielen auf
www.ecotronics.ch