Class Architect Notes

Wise Tuna knows about Web Development with COM, ASP, ADO, VB & JavaScript. Stay a while and bathe in the wisdom of Wise Tuna.

ClassArchitect Usage Notes

ClassArchitect is a useful program written in VB which will generate fully functional Visual Basic Classes for your COM objects with a whole load of standard methods, properties and attributes (including Audit code).

This may sound simple, but bear in mind that the methods generated handle all your ADO interfacing and that all methods that cause database modifications also support full auditing of who did what and when.

Note: The code generated is simply the VB source code of a VB Class and needs to be included into your project as a proper Class. It also has dependencies on the CommonADO code which is also provided on this site.

The generated Class will contain all the required attributes and properties and the following methods:

Description
GetAttributes
ValidateforDB (left empty since it is app specific)
SelectFromDB
InsertIntoDB
DeleteFromDB
UpdateInDB
SelectCollectionFromDB
BuildOptionList
BuildHTMLTable
BuildJScriptArrays
Class_Initialize

You may then modify the resultant code to cater for any extra functionality.

To make a class, all you need to do is create a simple text file in the following format:

class:,classname,tablename
keys:,attribute name, column name, datatype, generate key(y=auto,n=not auto)
lookup:,attribute name, column name, datatype
attr:,attribute name, column name, datatype
(repeated attr lines for each attribute not already specified as a key or lookup)

e.g

class:,Product,db_product
keys:,ProductKey,prod_id,long,Y
lookup:,ProdName,prod_name,string
attr:,ProdDesc,prod_description,string
attr:,TimeStamp,prod_modified,datetime

Where:

CLASS identifies the name of the class and the corresponding database table

KEYS identifies the name of the attribute, column and type of the underlying key for the class. Can be Integer or string. If the generate key attribute is set to Y and the key is Integer, then a key will be auto generated in the insertintodb method (using MAX + 1 from database table)

LOOKUP identifies the textual lookup attribute, column and type (not needed if you have a already specified a textual key)

ATTR specifies your class attributes, corresponding column names and types (Note: you do not need to re-specify KEY or LOOKUP lines)

DataType Can be any of String, Long, Date or DateTime

You can run ClassArchitect from the command line as follows:

classarchitect mysimplefile

If you run the program without a filename a simple popup will displayed where you can enter the name of your class definition file or browse your way to it.

A new file named classname.cls will be created which can then be added to your existing COM project. Note: It is assumed that your COM project follows the standards required by the CommonADO code. See its usage notes for details.

Example Output:

If ClassArchitect is invoked against the following very simple small test file:

class:,Product,db_product
keys:,ProductKey,prod_id,long,Y
lookup:,ProdName,prod_name,string
attr:,ProdDesc,prod_description,string
attr:,TimeStamp,prod_modified,datetime

You will get the following perfectly formed class

Option Explicit

'Local Attributes Definitions
Private mProductKey As Long
Private mProdName As String
Private mProdDesc As String
Private mTimeStamp As String

'Common Attributes
Private aud As New Audit
Private oRS As New ADODB.Recordset
Private mCurUser As String

' Common Properties
Public Property Let CurUser(NewVal As String)
   mCurUser = NewVal
End Property

Public Property Get CurUser() As String
   CurUser = mCurUser
End Property

'Class Properties
Public Property Let ProductKey(NewVal As Long)
   mProductKey = NewVal
End Property

Public Property Get ProductKey() As Long
   ProductKey = mProductKey
End Property

Public Property Let ProdName(NewVal As String)
   mProdName = NewVal
End Property

Public Property Get ProdName() As String
   ProdName = mProdName
End Property

Public Property Let ProdDesc(NewVal As String)
   mProdDesc = NewVal
End Property

Public Property Get ProdDesc() As String
   ProdDesc = mProdDesc
End Property

Public Property Let TimeStamp(NewVal As String)
   mTimeStamp = NewVal
End Property

Public Property Get TimeStamp() As String
   TimeStamp = mTimeStamp
End Property

Public Function MakeValidforJScript(dbStr)
   Dim pos

   If TypeName(dbStr) <> "string" Then
      MakeValidforJScript = CStr(dbStr)
      Exit Function
   End If

   pos = InStr(1, dbStr, """")

   Do While (pos > 0)
      dbStr = Left(dbStr, pos - 1) & "'" & Right(dbStr, Len(dbStr) - pos)
      pos = pos + 1
      pos = InStr(pos, dbStr, """")
   Loop

   pos = InStr(1, dbStr, Chr$(10))
   Do While (pos > 0)
      dbStr = Left(dbStr, pos - 1) & "\n" & Right(dbStr, Len(dbStr) - pos)
      pos = pos + 1
      pos = InStr(pos, dbStr, Chr$(10))
   Loop

   pos = InStr(1, dbStr, Chr$(13))
   Do While (pos > 0)
      dbStr = Left(dbStr, pos - 1) & Right(dbStr, Len(dbStr) - pos)
      pos = pos + 1
      pos = InStr(pos, dbStr, Chr$(13))
   Loop
   MakeValidforJScript = dbStr

   Exit Function
End Function

Public Function GetAttributes(RS As ADODB.Recordset)
   Me.ProductKey = RS.Fields("prod_id")
   Me.ProdName = RS.Fields("prod_name")
   Me.ProdDesc = RS.Fields("prod_description")
   Me.TimeStamp = db.ConvertedDBDate(RS.Fields("prod_modified"), fmtDateTime)
End Function

Public Function ValidateForDB()
End Function

Public Function Description() As String
   Dim Str As String
   Str = "prod_id: " & CStr(Me.ProductKey) & ", " & "prod_name: " & db.DoubleQuotesforDB(Trim(Me.ProdName)) & ", " & "prod_description: " & db.DoubleQuotesforDB(Trim(Me.ProdDesc)) & ", " & "prod_modified: " & db.ConvertedDBDate(Me.TimeStamp, fmtDateTime)
   Description = Str
End Function

Public Function SelectFromDB() As Boolean
   Dim SQLText As String
   SelectFromDB = False
   SQLText = "SELECT * FROM db_product WHERE prod_id=" & CStr(Me.ProductKey)
   On Error Resume Next
   oRS.Open SQLText, gConn, adOpenForwardOnly, adLockReadOnly
   On Error GoTo Error
   Call db.DBErrorHandler(gConn)
   If oRS.EOF Then
      Err.Raise 9999, "Product.SelectfromDB", "No rows found"
   Else
      Me.GetAttributes oRS
   End If
   oRS.Close
   Set oRS = Nothing
   SelectFromDB = True
   Exit Function
Error:
   Err.Raise 9999, "Product SelectfromDB", "Err.Description"
   Exit Function
End Function

Public Function InsertIntoDB(Optional InTransaction As Boolean = False) As Boolean
   InsertIntoDB = False
   Dim oCMD As New ADODB.Command
   Dim SQLText As String
   SQLText = "SELECT * FROM db_product WHERE prod_name=" & "'" & db.DoubleQuotesforDB(Trim(Me.ProdName)) & "'"
   On Error Resume Next
   oRS.Open SQLText, gConn, adOpenForwardOnly, adLockReadOnly
   On Error GoTo Error
   Call db.DBErrorHandler(gConn)
   Me.ValidateForDB
   If Not oRS.EOF Then
      Err.Raise 9999, "Product InsertIntoDB", "Duplicate Name"
   Else
      oRS.Close
      Set oRS = Nothing< BR >
      ' generate key value
      oRS.Open "SELECT IFNULL(MAX(prod_id),0)+1 FROM db_product", gConn, adOpenForwardOnly,adLockReadOnly
      On Error GoTo Error
      Call db.DBErrorHandler(gConn)
      Me.ProductKey = oRS.Fields(0)
      oRS.Close
      Set oRS = Nothing

      'start multi tran (but not if already in one)
      If InTransaction = False Then
         On Error Resume Next
         gConn.BeginTrans
         On Error GoTo Error
         Call db.DBErrorHandler(gConn)
      End If

      ' create the new Product
      SQLText = _
      "INSERT INTO db_product " & _
      "(prod_id,prod_name,prod_description,prod_modified) " & _
      "VALUES " & _
      "(" & CStr(Me.ProductKey) & "," & "'" & db.DoubleQuotesforDB(Trim(Me.ProdName)) & "'" & _
      "," & "'" & db.DoubleQuotesforDB(Trim(Me.ProdDesc)) & "'" & "," & "'" & _
      db.ConvertedDBDate(Me.TimeStamp, fmtDateTime) & "'" & ")"

      oCMD.ActiveConnection = gConn
      oCMD.CommandType = 1
      oCMD.CommandText = SQLText
      oCMD.CommandTimeout = 10
      On Error Resume Next
      oCMD.Execute
      On Error GoTo Error
      Call db.DBErrorHandler(gConn)
      Set oCMD = Nothing< BR >
      'log an audit entry for this action
      aud.CreateAuditEntry "create", Me.CurUser, "Product", Me.Description

      'commit multi tran (unless part of higher level tran)
      If InTransaction = False Then
         On Error Resume Next
         gConn.CommitTrans
         On Error GoTo Error
         Call db.DBErrorHandler(gConn)
      End If
   End If
   InsertIntoDB = True
   Exit Function
Error:
   Dim ErrText As String
   ErrText = Err.Description
   db.RollBack 'ensure multi tran rolled back
   Err.Raise 9999, "Product InsertIntoDB", ErrText
End Function

Public Function UpdateInDB(Optional InTransaction As Boolean = False) As Boolean
   UpdateInDB = False
   Dim oCMD As New ADODB.Command
   Dim SQLText As String
   Dim AudStr As String
   Dim OldObj As New Product
   OldObj.ProductKey = Me.ProductKey
   OldObj.SelectFromDB

   'build an audit entry for this action if something has changed
   If OldObj.ProductKey <> Me.ProductKey Then
      If AudStr <> "" Then
         AudStr = AudStr & ", "
      End If
      AudStr = AudStr & "ProductKey: " & CStr(OldObj.ProductKey) & " => " & CStr(Me.ProductKey)
   End If

   If OldObj.ProdName <> Me.ProdName Then
      If AudStr <> "" Then
         AudStr = AudStr & ", "
      End If
      AudStr = AudStr & "ProdName: " & db.DoubleQuotesforDB(Trim(OldObj.ProdName)) & " => " & db.DoubleQuotesforDB(Trim(Me.ProdName))
   End If

   If OldObj.ProdDesc <> Me.ProdDesc Then
      If AudStr <> "" Then
         AudStr = AudStr & ", "
      End If
      AudStr = AudStr & "ProdDesc: " & db.DoubleQuotesforDB(Trim(OldObj.ProdDesc)) & " => " & db.DoubleQuotesforDB(Trim(Me.ProdDesc))
   End If

   If OldObj.TimeStamp <> Me.TimeStamp Then
      If AudStr <> "" Then
         AudStr = AudStr & ", "
      End If
      AudStr = AudStr & "TimeStamp: " & db.ConvertedDBDate(OldObj.TimeStamp, fmtDateTime) & " => " & db.ConvertedDBDate(Me.TimeStamp, fmtDateTime)
   End If

   If AudStr <> "" Then
      'start multi tran (but not if already in one)
      If InTransaction = False Then
         On Error Resume Next
         gConn.BeginTrans
         On Error GoTo Error
         Call db.DBErrorHandler(gConn)
      End If

      SQLText = _
      "UPDATE db_product SET " & _
      "prod_id=" & CStr(Me.ProductKey) & "," & _
      "prod_name=" & "'" & db.DoubleQuotesforDB(Trim(Me.ProdName)) & "'" & "," & _
      "prod_description=" & "'" & db.DoubleQuotesforDB(Trim(Me.ProdDesc)) & "'" & "," & _
      "prod_modified=" & "'" & db.ConvertedDBDate(Me.TimeStamp, fmtDateTime) & "'" & " " & _
      "WHERE prod_id=" & CStr(Me.ProductKey)< BR>
      oCMD.ActiveConnection = gConn
      oCMD.CommandType = 1
      oCMD.CommandText = SQLText
      On Error Resume Next
      oCMD.Execute
      On Error GoTo Error
      Call db.DBErrorHandler(gConn)
      Set oCMD = Nothing
      aud.CreateAuditEntry "update", Me.CurUser, "Product", AudStr

      'commit multi tran (unless part of higher level tran)
      If InTransaction = False Then
         On Error Resume Next
         gConn.CommitTrans
         On Error GoTo Error
         Call db.DBErrorHandler(gConn)
      End If
   End If 'else no update required

   UpdateInDB = True
   Exit Function
Error:
   Dim ErrText As String
   ErrText = Err.Description
   db.RollBack 'ensure multi tran rolled back
   Err.Raise 9999, "Product UpdateInDB", ErrText
End Function

Public Function DeleteFromDB(Optional InTransaction As Boolean = False) As Boolean
   DeleteFromDB = False
   Dim oCMD As New ADODB.Command
   Dim SQLText As String
   If Me.SelectFromDB() = False Then
      Err.Raise 9999, "Product DeleteFromDB", "Problem selecting details"
   End If
   'start multi tran (but not if already in one)
   If InTransaction = False Then
      On Error Resume Next
      gConn.BeginTrans
      On Error GoTo Error
      Call db.DBErrorHandler(gConn)
   End If

   SQLText = "DELETE FROM db_product WHERE prod_id=" & CStr(Me.ProductKey)

   oCMD.ActiveConnection = gConn
   oCMD.CommandType = 1
   oCMD.CommandText = SQLText
   On Error Resume Next
   oCMD.Execute
   On Error GoTo Error
   Call db.DBErrorHandler(gConn)
   Set oCMD = Nothing

   'log an audit entry for this action
   aud.CreateAuditEntry "delete", Me.CurUser, "Product", Me.Description

   'commit multi tran (unless part of higher level tran)
   If InTransaction = False Then
      On Error Resume Next
      gConn.CommitTrans
      On Error GoTo Error
      Call db.DBErrorHandler(gConn)
   End If

   DeleteFromDB = True
   Exit Function
Error:
   Dim ErrText As String
   ErrText = Err.Description
   db.RollBack 'ensure multi tran rolled back
   Err.Raise 9999, "Product DeleteFromDB", ErrText
End Function

Public Function BuildOptionList(Name As String, Optional ValCols As String = "", Optional TxtCols As String = "", Optional Extras As String = "", Optional SQLRestrict = "", Optional OrderBy As String = "") As String

   On Error GoTo Error
   If ValCols = "" Then
      ValCols = "prod_id"
   End If

   If TxtCols = "" Then
      TxtCols = "prod_name"
   End If

   Dim SQLText As String
   SQLText = "SELECT * FROM db_product"

   If SQLRestrict <> "" Then
      SQLText = SQLText & " WHERE " & SQLRestrict
   End If
   If OrderBy <> "" Then
      SQLText = SQLText & " ORDER BY " & OrderBy
   Else
      SQLText = SQLText & " ORDER BY prod_name"
   End If

   BuildOptionList = db.CommonBuildOptionList(Name, SQLText, ValCols, TxtCols, Extras)
   Exit Function
Error:
   BuildOptionList = ""
   Err.Raise 9999, "Product BuildOptionList", Err.Description
End Function

Public Function SelectCollectionFromDB(objColl As Collection, Optional SQLRestrict = "", Optional OrderBy As String = "") As Boolean
   On Error GoTo Error
   SelectCollectionFromDB = False
   Dim SQLText As String
   Dim CurObject As Product
   SQLText = "SELECT * FROM db_product"< BR >
   If SQLRestrict <> "" Then
      SQLText = SQLText & " WHERE " & SQLRestrict
   End If
   If OrderBy <> "" Then
      SQLText = SQLText & " ORDER BY " & OrderBy
   Else
      SQLText = SQLText & " ORDER BY prod_name"
   End If

   Set objColl = New Collection
   oRS.Open SQLText, gConn, adOpenForwardOnly, adLockReadOnly
   While Not oRS.EOF
      Set CurObject = New Product
      CurObject.GetAttributes oRS
      objColl.Add Item:=CurObject
      oRS.MoveNext
   Wend

   oRS.Close
   Set oRS = Nothing
   SelectCollectionFromDB = True
   Exit Function
Error:
   Err.Raise 9999, "Product SelectCollectionFromDB", Err.Description
End Function

' This function will return the data from the database as a set of javascript arrays
' which can then be processed at the client end
Public Function BuildJScriptArrays(Optional TxtCols As String, Optional SQLRestrict = "", Optional OrderBy As String = "") As String < BR >
   Dim objColl As Collection
   Dim Jstr As String
   Dim Jindex As Integer
   Dim obj As Product
   Dim colArray As Variant
   Dim i As Integer
   Jindex = 0
   If TxtCols = "" Then
      ReDim colArray(3)
      colArray(0) = "prod_id"
      colArray(1) = "prod_name"
      colArray(2) = "prod_description"
      colArray(3) = "prod_modified"
      TxtCols = Join(colArray, ",")
   Else
      colArray = Split(TxtCols, ",")
   End If

   ' javascript header
   Jstr = _
   "<SCRIPT LANGUAGE=JAVASCRIPT>" & vbCrLf & _
   "" & vbCrLf & _
   "</SCRIPT>"

   ' return our javascript code
   BuildJScriptArrays = Jstr
   Exit Function
Error:
   BuildJScriptArrays = ""
   Err.Raise 9999, "Product BuildJScriptArrays", Err.Description
End Function

' This function will return the data from the database as an HTML Table
Public Function BuildHTMLTable(Optional TxtCols As String = "", Optional Headers As String = "", Optional SQLRestrict = "", Optional OrderBy As String = "", Optional TableDef As String = "") As String
   Dim objColl As Collection
   Dim Tstr As String
   Dim Jindex As Integer
   Dim obj As Product
   Dim colArray As Variant
   Dim hdrArray As Variant
   Dim i As Integer
   Jindex = 0
   If TxtCols = "" Then
      ReDim colArray(3)
      colArray(0) = "prod_id"
      colArray(1) = "prod_name"
      colArray(2) = "prod_description"
      colArray(3) = "prod_modified"
      TxtCols = Join(colArray, ",")
   Else
      colArray = Split(TxtCols, ",")
   End If

   'Table header
   If TableDef = "" Then
      Tstr = "<TABLE Border=1>"
   Else
      Tstr = "<TABLE " + TableDef + ">"
   End If

   ' get the data into a collection
   Me.SelectCollectionFromDB objColl, SQLRestrict, OrderBy
   ' table header (configurable)
   If Headers = "" Then
      Headers = "prod_id,prod_name,prod_description,prod_modified"
   End If

   Tstr = Tstr + "<TR>"
   hdrArray = Split(Headers, ",")
   For i = 0 To UBound(hdrArray)
      Tstr = Tstr + "<TD>" + hdrArray(i)
   Next
   For Each obj In objColl
      Tstr = Tstr & "<TR>"
      If InStr(TxtCols, "prod_id") > 0 Then
         Tstr = Tstr & "<TD>" & obj.ProductKey
      End If
      If InStr(TxtCols, "prod_name") > 0 Then
         Tstr = Tstr & "<TD>" & obj.ProdName
      End If
      If InStr(TxtCols, "prod_description") > 0 Then
         Tstr = Tstr & "<TD>" & obj.ProdDesc
      End If
      If InStr(TxtCols, "prod_modified") > 0 Then
         Tstr = Tstr & "<TD>" & obj.TimeStamp
      End If
   Next

   'table end
   Tstr = Tstr & "</TABLE>"
   BuildHTMLTable = Tstr
   Exit Function
Error:
   BuildHTMLTable = ""
   Err.Raise 9999, "Product BuildHTMLTable", Err.Description
End Function

Private Sub Class_Initialize()
   InitialiseApp
End Sub

wisetuna.com & wisetuna.co.uk are owned by Deep Thought Consultants Ltd