'================================================================================================
' Creator: Jay Ohman, Ohman Automation Corp. - http://www.OhmanCorp.com
' Use of this information is strictly at your own risk, I/we can not be held liable for use of this information.
' The sharing of this information is allowed, with these notes intact.
' for more information, and introduction, see http://www.OhmanCorp.com/ADO-DBProps.asp
'
' quick make Active Server Page, based on a Database table
' this example just creates a page for displaying table data
' for functionality to: add, edit, delete records - send me an email: jayro at ohmancorp.com
' pass in the database fully-pathed-name, table name, and output path
'================================================================================================
'
' converts returned ColumnsSchema IntegerValue to DATA_TYPE name, MS Access values only
' for non MS Access DATA_TYPEs, see the database available at: http://www.OhmanCorp.com/ADO-DBProps.asp
' or the Microsoft website: http://msdn2.microsoft.com/en-gb/library/ms675318.aspx
'------------------------------------------------------------------------------------------------
Function ConvertDataType( xVal )
Select Case xVal
Case 2
ConvertDataType = "adSmallInt"
Case 3
ConvertDataType = "adInteger"
Case 4
ConvertDataType = "adSingle"
Case 5
ConvertDataType = "adDouble"
Case 6
ConvertDataType = "adCurrency"
Case 7
ConvertDataType = "adDate"
Case 11
ConvertDataType = "adBoolean"
Case 17
ConvertDataType = "adUnsignedTinyInt"
Case 72
ConvertDataType = "adGUID"
Case 128
ConvertDataType = "adBinary"
Case 130
ConvertDataType = "adWChar"
Case 131
ConvertDataType = "adNumeric"
End Select
End Function
'------------------------------------------------------------------------------------------------
' all of this information is available in a downloadable table at http://www.OhmanCorp.com/ADO-DBProps.asp
' Assigns a 'class' for DATA_TYPE values, so auto-scripting knows to surround values with
' special characters. Example, dates: #01/01/2000# need pound signs around the value.
'------------------------------------------------------------------------------------------------
Function GetDataStyle( xVal )
Select Case xVal
Case 2, 3, 4, 5, 6, 17, 131 ' adSmallInt, adInteger, adSingle, adDouble, adCurrency,
' adUnsignedTinyInt, adNumeric
GetDataStyle = 1 ' numeric - don't surround value
Case 7 ' adDate
GetDataStyle = 2 ' date/time - use # around value
Case 11 ' adBoolean
GetDataStyle = 3 ' boolean - use TRUE or FALSE
Case 130 ' adWChar
GetDataStyle = 4 ' text - use ' around value
Case 72 ' adGUID
GetDataStyle = 5 ' GUID - can't edit in a web page (display only) - use ' around value
Case 128 ' adBinary
GetDataStyle = 6 ' OLE Object - can't edit/display in a web page
End Select
'---------------------------------------------------
' All MS Access DataTypes: AccessType = DATA_TYPE = IntValue
'---------------------------------------------------
' AutoNum LongInteger = adInteger = 3
' AutoNum RepID = adGUID = 72
' Currency = adCurrency = 6
' Date/Time = adDate = 7
' Hyperlink = asWChar = 130 (text)
' Memo = adWChar = 130
' Numeric Byte = adUnsignedTinyInt = 17
' Numeric Decimal = adNumeric = 131
' Numeric Double = adDouble = 5
' Numeric Integer = adSmallInt = 2
' Numeric Long Integer = adInteger = 3
' Numeric RepID = adGUID = 72
' Numeric Single = adSingle = 4
' OLEObject = adBinary = 128
' Text = adWChar = 130
' Yes/No = adBoolean = 11
'---------------------------------------------------
End Function
'------------------------------------------------------------------------------------------------
' return the DataType symbol for this DataType
'------------------------------------------------------------------------------------------------
Function GetDataTypeSym( xVal )
Select Case xVal
Case 2, 3, 4, 5, 6, 17, 131 ' adSmallInt, adInteger, adSingle, adDouble, adCurrency,
' adUnsignedTinyInt, adNumeric
GetDataTypeSym = "" ' numeric - don't surround value
Case 7 ' adDate
GetDataTypeSym = "#" ' date/time - use # around value
Case 11 ' adBoolean
GetDataTypeSym = "" ' boolean - use TRUE or FALSE
Case 130 ' adWChar
GetDataTypeSym = "'" ' text - use ' around value
Case 72 ' adGUID
GetDataTypeSym = "'" ' GUID - can't edit in a web page (display only) - use ' around value
Case 128 ' adBinary
GetDataTypeSym = "" ' OLE Object - can't edit/display in a web page
End Select
End Function
'================================================================================================
' sample commands:
' cscript G:\usr\JayRO\cmd\MakeASP-DbCode.vbs P:\WWW\OACroot\SussexPlace_biz\bin\db\SPlace.mdb t_Calendar &_
' P:\WWW\OACroot\SussexPlace_biz\bin\db\x.asp
' cscript G:\usr\JayRO\cmd\MakeASP-DbCode.vbs G:\usr\ClientStuff\TransExp\UserList.mdb t_User &_
' G:\usr\ClientStuff\TransExp\dev\x.asp
' Good reference, SchemaEnum: http://msdn2.microsoft.com/en-gb/library/ms675274.aspx
' Credit for ISAUTONUMBER property: Paul Clement, in forum: VBMonster.com
' link: http://www.vbmonster.com/Uwe/Forum.aspx/vb-ado/2148/Identify-Autonumber-field-using-VB6
Set oArgs = WScript.Arguments
Set fso = CreateObject("Scripting.FileSystemObject")
ReDim xColsCont(5 ,10), xKeysCont(5 ,10)
xContinue = -1
If oArgs.Count <> 3 Then ' Test for number of arguments
WScript.Echo "3 arguments required, aborting script"
xContinue = 0
End If
If xContinue Then
xSourceDB = oArgs(0)
xTableName = oArgs(1)
xDestFile = oArgs(2)
xDestDir = Left( xDestFile, InStrRev( xDestFile, "\"))
If Not fso.FileExists(xSourceDB) Then ' Test that the passed database exists
WScript.Echo "Fully pathed source database not found, aborting script"
xContinue = 0
End If
If Not fso.FolderExists(xDestDir) Then ' Test that the destination directory exists
WScript.Echo "Destination Directory not found, aborting script"
xContinue = 0
End If
If Right(xDestFile, 4) <> ".asp" Then ' Test that the destination file ends in .asp
WScript.Echo "Destination File must end in '.asp', aborting script"
xContinue = 0
End If
End If
If xContinue Then
Set Conn = CreateObject("ADODB.Connection")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & xSourceDB
Set TablesSchema = Conn.OpenSchema(20) ' 20 = adSchemaTables
TablesSchema.Filter = "TABLE_NAME = '" & xTableName & "'"
If TablesSchema.EOF Then ' Test that the specified table exists
WScript.Echo "Table " & xTableName & " not found, aborting script"
xContinue = 0
End If
End If
If xContinue Then ' All the tests passed, so continue
WScript.Echo "Properties for table: " & TablesSchema("TABLE_NAME")
'----------------------- ' get the relationship information for the table
' extract and combine Key info and ForeignKey info
' somewhat of a hacked interpretation
Set KeySchema = Conn.OpenSchema(8) ' 8 = adSchemaKeyColumnUsage
Set RelSchema = Conn.OpenSchema(27) ' 27 = adSchemaForeignKeys
KeySchema.Filter = "TABLE_NAME = '" & xTableName & "'"
' xRelCount = KeySchema.RecordCount ' tried this, but always returns -1,
xData = KeySchema.GetRows(-1) ' -1 = adGetRowsRest
xRelCount = UBound(xData, 2) + 1 ' so get RecordCount this way
ReDim Preserve xKeysCont(5, xRelCount)
x = 0 : xPKCount = 0
WScript.Echo "Relationship Information - (" & xRelCount & " relationships found)"
WScript.Echo " LineNo Table.Field IsPrimKey CountRelationUsage/SpecOneSideOfRelation"
KeySchema.MoveFirst
Do While Not KeySchema.EOF ' iterate through each relationship
xKeysCont(0, x) = KeySchema("TABLE_NAME")
xKeysCont(1, x) = KeySchema("COLUMN_NAME")
If KeySchema("CONSTRAINT_NAME") = "PrimaryKey" Then
xKeysCont(2, x) = TRUE ' Is PrimaryKey?
RelSchema.Filter = "PK_TABLE_NAME = '" & KeySchema("TABLE_NAME") & "' AND PK_COLUMN_NAME = '" & _
KeySchema("COLUMN_NAME") & "'"
xRows = UBound((RelSchema.GetRows(-1)), 2) + 1
xKeysCont(3, x) = xRows
Else
xKeysCont(2, x) = FALSE ' Is PrimaryKey?
RelSchema.Filter = "FK_NAME = '" & KeySchema("CONSTRAINT_NAME") & "'"
xKeysCont(3, x) = RelSchema.Fields("PK_TABLE_NAME")
xKeysCont(4, x) = RelSchema.Fields("PK_COLUMN_NAME")
xPKCount = xPKCount + 1
xKeysCont(5, x) = xPKCount
End If
RelSchema.Filter = ""
x = x + 1
KeySchema.MoveNext
Loop
KeySchema.Close
RelSchema.Close
For x = 0 To (xRelCount - 1) ' now ouput the relationship information stored in the array
If xKeysCont(2, x) Then
If xKeysCont(3, x) = 1 Then xStr = " table)" Else xStr = " tables)"
xStr = "(used in " & xKeysCont(3, x) & xStr
Else
xStr = xKeysCont(3, x) & "." & xKeysCont(4, x)
End If
WScript.Echo " " & x & ") " & xKeysCont(0, x) & "." & xKeysCont(1, x) & ", " & _
xKeysCont(2, x) & ", " & xStr & ", " & xKeysCont(5, x)
Next
'----------------------- ' now get the column information for the table
Set rst1 = CreateObject("ADODB.Recordset")
StrSQL = "SELECT * FROM " & xTableName & ";"
rst1.Open StrSQL, Conn, 3, 1 ' Fetch the table as a recordset, to read ISAUTOINCREMENT prop
Set ColumnsSchema = Conn.OpenSchema(4, Array(Empty, Empty, "" & TablesSchema("TABLE_NAME")))
' 4 = adSchemaColumns
xData = ColumnsSchema.GetRows(-1) ' -1 = adGetRowsRest
xColCount = UBound(xData, 2) + 1
ColumnsSchema.MoveFirst
ReDim Preserve xColsCont(5, xColCount)
WScript.Echo "Column Information - (" & xColCount & " columns in table)"
WScript.Echo " Ordinal ColName DataType TextLen IsAutoNum IsConnected"
Do While Not ColumnsSchema.EOF ' itereate through the desired properties for each column
x = ColumnsSchema("ORDINAL_POSITION") ' dumping the values into an array,
' this will skip where x = 0
xColsCont(0, x) = ColumnsSchema("ORDINAL_POSITION")
xColsCont(1, x) = ColumnsSchema("COLUMN_NAME")
xColsCont(2, x) = ColumnsSchema("DATA_TYPE")
xColsCont(3, x) = ColumnsSchema("CHARACTER_MAXIMUM_LENGTH")
xColsCont(4, x) = rst1.Fields(x-1).Properties("ISAUTOINCREMENT").Value
If ColumnsSchema("COLUMN_DEFAULT") = "GenGUID()" Then xColsCont(4, x) = TRUE
For y = 0 To (xRelCount - 1)
If (xKeysCont(1, y) = xColsCont(1, x)) AND (Not xKeysCont(2, y)) Then _
xColsCont(5, x) = y : Exit For
Next
ColumnsSchema.MoveNext
Loop
ColumnsSchema.Close
rst1.Close
Set rst1 = Nothing
For x = 1 To xColCount ' now ouput the table-column information stored in the array
WScript.Echo " " & x & ") " & xColsCont(0, x) & ", " & xColsCont(1, x) & ", " & ConvertDataType(xColsCont(2, x)) & _
", " & xColsCont(3, x) & ", " & xColsCont(4, x) & ", " & xColsCont(5, x)
Next
TablesSchema.Close
Conn.Close
Else ' handle bad parameter data
WScript.Echo "invalid arguments" & vbCrLf
WScript.Echo "purpose: quick make Active Server Page, based on a MS Access table"
WScript.Echo "usage: MakeASP-DbCode.vbs FullyPathedDB-Name TableName OutputPath\FileName.asp"
xContinue = 0
End If
Set rst1 = nothing
Set TableSchema = nothing
Set KeySchema = nothing
Set RelSchema = nothing
Set Conn = nothing
If Not xContinue Then
WScript.Quit
End If
WScript.Echo "Making ASP page..."
Set fso = CreateObject("Scripting.FileSystemObject")
Set tf = fso.CreateTextFile( xDestFile , True) ' Open the destination ASP (text) file
' Create some very basic HTML top of page stuff
tf.WriteLine("<!doctype html public ""-//w3c//dtd html 4.0 transitional//en"">" & vbCrLf & _
"<HTML>" & vbCrLf & "<HEAD>" & vbCrLf & _
" <TITLE>OAC - Display An Access Table - " & xTableName & " -</TITLE>" & vbCrLf & _
"</HEAD>" & vbCrLf & "<BODY>" & vbCrLf & _
" <TABLE WIDTH=""100%"" BORDER=""1"" CELLPADDING=""0"" CELLSPACING=""0"">" & vbCrLf & _
" <TH COLSPAN=""" & xColCount & """>Listing all records and field properties,<BR>" & vbCrLf & _
" for table: " & xTableName & ",<BR>" & vbCrLf & _
" from database: " & xSourceDB & ".</TH>" & vbCrLf & _
" <TR><TD COLSPAN=""" & xColCount & """><B>Relationship Information</B></TD></TR>")
If xColCount > 3 Then xColSpanStr = "<TD COLSPAN=""" & xColCount - 3 & """> </TD>" Else xColSpanStr = ""
tf.WriteLine(" <TR><TD ALIGN=""CENTER"">Table.Field</TD><TD ALIGN=""CENTER"">IsPrimaryKey?</TD>" & vbCrLf & _
" <TD>Count Of Tables /or/ Specify One Side Of Relationship</TD>" & xColSpanStr & "</TR>")
For x = 0 To (xRelCount - 1) ' List relationship/key information
tf.WriteLine(" <TR>" & vbCrLf & " <TD ALIGN=""LEFT"">" & xKeysCont(0, x) & "." & xKeysCont(1, x) & _
"</TD><TD ALIGN=""LEFT"">" & xKeysCont(2, x) & "</TD>" & vbCrLf & " <TD ALIGN=""LEFT"">" & _
xKeysCont(3, x) & "." & xKeysCont(4, x) & "</TD>" & xColSpanStr & "</TR>")
Next
tf.WriteLine(" <TR><TD COLSPAN=""" & xColCount & _
"""><B>Create Dynamic HTML Table Code, from an Access Table.</B>" & vbCrLf & _
" (IsConnected means this field is a ForeignKey Field)</TD></TR>" & vbCrLf & _
" <TR>")
For x = 1 To xColCount ' output each column name
tf.WriteLine(" <TD ALIGN=""CENTER""><B>" & xColsCont(1, x) & "</B></TD>")
Next
tf.WriteLine(" </TR>")
tf.WriteLine(" <TR>")
For x = 1 To xColCount ' output each column DataType
If xColsCont(4, x) Then xStr = " - Auto" Else xStr = ""
If xColsCont(2, x) = "adWChar" Then xStr = " - " & xColsCont(3, x)
tf.WriteLine(" <TD ALIGN=""CENTER"">" & ConvertDataType(xColsCont(2, x)) & xStr & "</TD>")
Next
tf.WriteLine(" </TR>")
tf.WriteLine(" <TR>")
For x = 1 To xColCount ' output IsConnected information
y = xColsCont(5, x)
If y = "" Then xStr = " " Else xStr = xKeysCont(3, y) & "." & xKeysCont(4, y)
tf.WriteLine(" <TD ALIGN=""CENTER"">" & xStr & "</TD>")
Next
tf.WriteLine(" </TR>")
' output database connector and primary recordset connector
tf.WriteLine("<%" & vbCrLf & _
"If IsObject(Session(""DB_conn"")) Then" & vbCrLf & _
" Set Conn = Session(""DB_conn"")" & vbCrLf & _
"Else" & vbCrLf & _
" Set Conn = Server.CreateObject(""ADODB.Connection"")" & vbCrLf & _
" strSource = """ & xSourceDB & """" & vbCrLf & _
" strConn = ""Provider=Microsoft.Jet.OLEDB.4.0;Data Source="""""" & strSource & """"""""" & vbCrLf & _
" Conn.Open strConn" & vbCrLf & _
" ' Conn.Open ""DSN=YourDataSourceName"" ' for quick conversion to a DSN" & vbCrLf & _
" Set Session(""DB_conn"") = Conn" & vbCrLf & _
"End If" & vbCrLf & vbCrLf & _
"Set rst0 = Server.CreateObject(""ADODB.Recordset"")" & vbCrLf & _
"StrSQL = ""SELECT * FROM " & xTableName & ";""" & vbCrLf & _
"rst0.Open StrSQL, Conn, 3, 1 '3=adUseClient, 1=adOpenForwardOnly" & vbCrLf)
z = 0
If xPKCount > 0 Then ' output recordset connector for fields that are many side of joins
For x = 1 to xPKCount
Do While xKeysCont(2, z) ' Find key entry where IsPrimKey = FALSE
z = z + 1
Loop
xPTable = xKeysCont(3, z)
tf.WriteLine("Set rst" & x & " = Server.CreateObject(""ADODB.Recordset"")" & vbCrLf & _
"StrSQL = ""SELECT * FROM " & xPTable & ";""" & vbCrLf & _
"rst" & x & ".Open StrSQL, Conn, 3, 1" & vbCrLf)
z = z + 1
Next
End If
tf.WriteLine ("Do While Not rst0.EOF %>" & vbCrLf & " <TR>")
For x = 1 To xColCount ' output field display coding
xStr = ""
If xColsCont(5, x) <> "" Then
y = xColsCont(5, x) ' which KeyRowNo?
z = xKeysCont(5, y) ' which assigned xPKNumber?
xPField = xKeysCont(4, y)
xStr1 = GetDataTypeSym(xColsCont(2, x))
xStr = "<%" & vbCrLf & " rst" & z & ".Filter = """ & xKeysCont(4, y) & " = " & _
xStr1 & """ & rst0(""" & xColsCont(1, x) & """) & """ & xStr1 & """" & vbCrLf & _
" xStr = rst" & z & "(1)" & _
" %> [<%= xStr %>]"
End If
tf.WriteLine(" <TD><%= rst0(""" & xColsCont(1, x) & """) %>" & xStr & "</TD>")
Next
tf.WriteLine (" </TR><%" & vbCrLf & " rst0.MoveNext" & vbCrLf & "Loop" & vbCrLf)
For x = 0 to xPKCount ' close all the open databases
tf.WriteLine("rst" & x & ".Close")
Next
tf.WriteLine("Set Conn = nothing" & vbCrLf & "%>")
tf.WriteLine("</TABLE>")
tf.WriteLine("</BODY>" & vbCrLf & "</HTML>")
tf.WriteLine("")
tf.Close
WScript.Echo " Done"
|