Results 1 to 5 of 5

Thread: Reading Databases with ADOX library

  1. #1
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    0

    Default Reading Databases with ADOX library

    I have used the DAO type library for years and ADO now for a year or so for reading databases into LISP.

    This code accepts a database file name and an sql string to create a record set that is converted into a list of sublists (first sublist is the fields)

    Code:
    Imports System
    Imports Autodesk.AutoCAD
    Imports Autodesk.AutoCAD.ApplicationServices
    Imports Autodesk.AutoCAD.DatabaseServices
    Imports Autodesk.AutoCAD.EditorInput
    Imports Autodesk.AutoCAD.Geometry
    Imports Autodesk.AutoCAD.Runtime
    Imports Autodesk.AutoCAD.Windows
    Imports ACADApplication = Autodesk.AutoCAD.ApplicationServices.Core.Application
    Imports ADOX
    
    Public Class Class1
    
        ' Global Flags set to 3 is a flag that prints messages to both command line, 
        ' console and set to 7 to display message box if desired.
        Shared globalFlags As Int16 = 1 + 2
    #Region "Public Access Data Object (ADOX) functions"
        ''' <summary>
        ''' 
        ''' </summary>
        ''' <param name="rbfArguments"></param>
        ''' <returns></returns>
        ''' <remarks>LISP Syntax: (ADOXToList "c:\\acad\\newmdb.mdb" "Select FirstName, LastName, Address From AddressTable where LastName Like '%'"")
        ''' </remarks>
        <LispFunction("ADOXtoList")> _
        Public Function ADOXToList(ByVal rbfArguments As ResultBuffer)
            Try
                Dim arrArguments As TypedValue() = rbfArguments.AsArray
                If arrArguments.Length > 1 Then
                    Dim strFullName As String = FileFind(arrArguments(0).Value.ToString)
                    If strFullName Is Nothing Then
                        MessageWrite("File ''" & arrArguments(0).Value.ToString & "'' Not Found", globalFlags)
                        Return Nothing
                    End If
                    Return DatabaseRead(strFullName, arrArguments(1).Value.ToString)
                End If
                MessageWrite("error: Too Few Arguments", globalFlags)
            Catch exception As System.Exception
                ErrorMessage(Err, globalFlags)
            End Try
            Return Nothing
        End Function
        ''' <summary>
        '''  Function to read a database given a filename and a strucutred queiry language statement
        '''  and return the recordset as a list of sublists
        ''' </summary>
        ''' <param name="strFullName"></param>
        ''' <param name="strSQL"></param>
        ''' <returns></returns>
        Public Function DatabaseRead(ByVal strFullName As String, ByVal strSQL As String)
            Dim connection As New ADODB.Connection
            Dim catalog As New ADOX.Catalog
            Dim recordSet As New ADODB.Recordset
            Try
                Dim rbfReturn As New ResultBuffer
                Dim strConnection As String = ConnectionString(strFullName)
                If strConnection IsNot Nothing Then
                    connection.Open(strConnection)
                    catalog.ActiveConnection = connection
                    recordSet = connection.Execute(strSQL)
    
                    If recordSet IsNot Nothing Then
                        rbfReturn = RecordSetToResultBuffer(recordSet)
                    End If
                    'Clean up
                    connection.Close()
                    catalog = Nothing
                    connection = Nothing
                    Return rbfReturn
                End If
                Return Nothing
            Catch exception As System.Exception
                catalog = Nothing
                If connection IsNot Nothing Then
                    If connection.State = 1 Then connection.Close()
                End If
                connection = Nothing
                ErrorMessage(Err, globalFlags)
                Return Nothing
            End Try
    
        End Function
        ''' <summary>
        ''' Function to convert a record set to a list of sublists
        ''' </summary>
        ''' <param name="recordset"></param>
        ''' <returns>ResultBuffer (list of sublists)</returns>
        Public Function RecordSetToResultBuffer(ByVal recordset As ADODB.Recordset)
            Try
                Dim rbfReturn As New ResultBuffer
                If recordset IsNot Nothing And Not recordset.BOF Then
                    recordset.MoveFirst()
                    rbfReturn.Add(New TypedValue(5016, -1))
                    rbfReturn.Add(New TypedValue(5016, -1))
                    For Each field As ADODB.Field In recordset.Fields
                        rbfReturn.Add(New TypedValue(5005, field.Name))
                    Next
                    rbfReturn.Add(New TypedValue(5017, -1))
                    Do While Not recordset.EOF
                        rbfReturn.Add(New TypedValue(5016, -1))
                        For Each field As ADODB.Field In recordset.Fields
                            rbfReturn.Add(ObjectToTypedValue(field.Value))
                        Next
                        recordset.MoveNext()
                        rbfReturn.Add(New TypedValue(5017, -1))
                    Loop
                    rbfReturn.Add(New TypedValue(5017, -1))
                    Return rbfReturn
                End If
            Catch exception As System.Exception
                ErrorMessage(Err, globalFlags)
            End Try
            Return Nothing
        End Function
    
        ''' <summary>
        ''' Function to get the correct connection string for each type of database file 
        ''' and 64 bit and 32 bit architectures.
        ''' </summary>
        ''' <param name="strFullName"></param>
        ''' <param name="blnSecurity"></param>
        ''' <returns>Connection String as string or nothing </returns>
    
        Private Function ConnectionString(ByVal strFullName As String, _
                                          Optional ByVal blnSecurity As Boolean = False)
            Try
                Dim strProvider As String = Nothing
                Select Case System.IO.Path.GetExtension(strFullName).ToUpper
                    Case ".ACCDB"
                        strProvider = "Microsoft.ACE.OLEDB.12.0; Data Source="
                    Case ".MDB"
                        If IntPtr.Size = 8 Then '<- 8 is 64x architecture
                            strProvider = "Microsoft.ACE.OLEDB.12.0; Data Source="
                        Else
                            strProvider = "Microsoft.Jet.OLEDB.4.0; Data Source="
                        End If
                    Case ".MDF" Or ".UDF"
                        strProvider = "Microsoft.Jet.OLEDB.4.0; Data Source="
                End Select
                If strProvider IsNot Nothing Then
                    Return "Provider=" & strProvider & "'" & strFullName & "'" & ";Persist Security Info=" & blnSecurity.ToString & ";"
                End If
    
            Catch exception As System.Exception
                ErrorMessage(Err, globalFlags)
            End Try
    
            Return Nothing
        End Function
    #End Region
    
        ' Region of Message Functions
    #Region "Public Error Message functions"
        ''' <summary>
        ''' Sub routine for printing error messages to the command line and console
        ''' </summary>
        ''' <param name="objError"></param>
        ''' <param name="flags"></param>
        ''' 
        Public Shared Sub ErrorMessage(ByVal objError As ErrObject, Optional ByVal flags As Int16 = 3)
            If objError.Number <> 0 Then
                Dim strMessage As String = objError.Source & "-->" & objError.Description
                MessageWrite(strMessage, flags)
            End If
        End Sub
    
        ''' <summary>
        ''' Function for finding a file in the AutoCAD search path or specified folder.
        ''' </summary>
        ''' <param name="strFullName"></param>
        ''' <returns>File Full Name with Path </returns>
    
        Public Shared Function FileFind(ByVal strFullName As String)
            Try
                Dim database = HostApplicationServices.WorkingDatabase
                strFullName = HostApplicationServices.Current.FindFile(strFullName, database, FindFileHint.Default)
                If strFullName IsNot Nothing Then
                    Return strFullName
                End If
            Catch exception As System.Exception
                ErrorMessage(Err, globalFlags)
            End Try
            Return Nothing
        End Function
    
        ''' <summary>
        ''' Sub routine for writing to command line, console and/or message box.
        ''' </summary>
        ''' <param name="strMessage"></param>
        ''' <param name="flags"></param>
        ''' <remarks>
        ''' 0 Dont write messages to command line or console
        ''' 1 Write Message to Console
        ''' 2 Write Message to Command Line
        ''' 4 Write in a message box
        ''' </remarks>
        Public Shared Sub MessageWrite(ByVal strMessage As String, Optional ByVal flags As Int16 = 3)
            If (flags And 1) = 1 Then _
                Console.WriteLine(strMessage.ToString)
            If (flags And 2) = 2 Then _
                ACADApplication.DocumentManager.MdiActiveDocument.Editor.WriteMessage(strMessage.ToString)
            If (flags And 4) = 4 Then _
                MsgBox(strMessage.ToString)
        End Sub
    
    #End Region
    
    
    End Class
    AutomateCAD

  2. #2
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    0

    Default Re: Reading Databases with ADOX library

    This region needs to be added to the above class (I ran out of room)

    Code:
    #Region "Public ObjectToTypedValueer functions"
        '  Blank (like returned by princ)
        Public Shared Function ObjectToTypedValue() As TypedValue
            Return New TypedValue(LispDataType.None, -1)
        End Function
    
        ' Integers (32 bit or other)
        Public Shared Function ObjectToTypedValue(value As Integer) As TypedValue
            Return New TypedValue(LispDataType.Int16, value)
        End Function
    
        ' 16 bit integers
        Public Shared Function ObjectToTypedValue(value As Int16) As TypedValue
            Return New TypedValue(LispDataType.Int16, value)
        End Function
    
        ' Doubles
        Public Shared Function ObjectToTypedValue(value As Double) As TypedValue
            Return New TypedValue(LispDataType.Double, value)
        End Function
    
        ' Strings
        Public Shared Function ObjectToTypedValue(value As String) As TypedValue
            Return New TypedValue(LispDataType.Text, value)
        End Function
    
        ' Booleans
        Public Shared Function ObjectToTypedValue(value As Boolean) As TypedValue
            If CBool(value) Then
                Return New TypedValue(LispDataType.T_atom, -1)
            End If
            Return New TypedValue(LispDataType.Nil, -1)
        End Function
    
        ' 2d Points
        Public Shared Function ObjectToTypedValue(value As Point2d) As TypedValue
            Return New TypedValue(LispDataType.Point2d, value)
        End Function
    
        ' 3d Points
        Public Shared Function ObjectToTypedValue(value As Point3d) As TypedValue
            Return New TypedValue(LispDataType.Point3d, value)
        End Function
    
    #End Region
    AutomateCAD

  3. #3
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    0

    Default Re: Reading Databases with ADOX library

    The reference files are:

    Refernce Image.jpg
    Last edited by peter; 2014-02-27 at 07:15 PM.
    AutomateCAD

  4. #4
    Certifiable AUGI Addict
    Join Date
    2015-11
    Location
    Jo'burg SA
    Posts
    4,512
    Login to Give a bone
    0

    Default Re: Reading Databases with ADOX library

    You might also want to check what nullptr did here: http://www.theswamp.org/index.php?topic=28286.0

    I.e. an embeddable / stand-alone database file (Sqlite).

  5. #5
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    0

    Default Re: Reading Databases with ADOX library

    This is a sample of calling this function from lisp

    Code:
    (defun C:ADOX ()
     (textscr)
     (ADOXToList "c:\\acad\\newmdb.adodb"
       "Select FirstName, LastName, ZIPCode From AddressTable where State Like 'OR'")
    
    )
    This is the function run.

    Code:
    Command: ADOX
    (("FirstName" "LastName" "ZIPCode") ("John" "Doe" 97222) ("Jane" "Doe" 97222) ("Bill" "Note" 97208))
    Attached Files Attached Files
    Last edited by peter; 2014-02-27 at 07:06 PM.
    AutomateCAD

Similar Threads

  1. What about modifying the databases?
    By Chuckyd67 in forum ACA General
    Replies: 1
    Last Post: 2007-12-26, 04:29 PM
  2. Databases
    By smooth shoes in forum AutoCAD General
    Replies: 3
    Last Post: 2007-10-19, 02:18 PM
  3. map3d and databases
    By gisdude in forum AutoCAD Map 3D - General
    Replies: 2
    Last Post: 2006-06-06, 08:35 PM
  4. Saving New Door To Library & Personal Library
    By SCShell in forum Revit Architecture - General
    Replies: 10
    Last Post: 2005-05-11, 08:01 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •