[Cleper]

Народ подскажите как получить доступ к таблицам БД Access?
Допустим есть таблица CLEPER в базе Access. Как мне к ней обратиться чтобы можно было извлечь данные!

[Кулик Алексей aka kpblc]

Ххе. Вопрос - из какого места до таблицы пробуешь достучаться? Из Access?

Код:

[Выделить все]

select * from cleper;

Из VB? Тогда надо делать связку с ADO 2.8 и через него так же запросом
---
Добавлено:
вообще-то странно - ты ж а mysql и php вроде как работаешь, вопрос явно не твоего уровня.

[Cleper]

Хотелосьбы через autoLISP
через (vlax-create-object "Access.Application")

[Кулик Алексей aka kpblc]

Стоп-стоп! Ни в коем случае! Это ж если тебе надо будет выполнять 100 запросов в минуту, у тебя в памяти будет болтаться 100 Access'ов! Пока они освободятся, машина уйдет в перезагрузку. Лови лисп. Автор не я, стырено было с сайта флемингов (давно там не был, может, и заработало). Собственно код:

Код:

[Выделить все]

;;; A library to be used to access a database from Visual LISP
;;; in AutoCAD 2000 or higher using ActiveX Data Objects
;;; (ADO)

;;; Copyright (C) 1999-2003 by The Fleming Group

;;; Permission to use, copy, modify, and distribute this
;;; software for any purpose and without fee is hereby
;;; granted, provided that the above copyright notice
;;; appears in all copies and that both that copyright
;;; notice and the limited warranty and restricted
;;; rights notice below appear in all supporting
;;; documentation.

;;; THE FLEMING GROUP PROVIDES THIS PROGRAM "AS IS" AND WITH
;;; ALL FAULTS. THE FLEMING GROUP SPECIFICALLY DISCLAIMS ANY
;;; IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS FOR A
;;; PARTICULAR USE.
;;; THE FLEMING GROUP DOES NOT WARRANT THAT THE OPERATION OF
;;; THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.

;;; ----------------------------------------------------------

;;; Revision 2.32 March 2004 by JRF: Fixed a bug in
;;; ADOLISP_GetTablesAndViews.

;;; Revision 2.31 July 30, 2003 by JRF: Removed
;;; ActualSize from the list of field properties
;;; collected when a SELECT statement is executed:
;;; if no rows were returned (and some other
;;; conditions were true, but I don't know exactly
;;; what conditions) asking about ActualSize
;;; caused an automation error that is untrappable.
;;; It's possible but a litle complex to get
;;; ActualSize back; contact me it you need it.

;;; Revision 2.30 May 1, 2003 by JRF:  Added the
;;; ADOLISP_GetColumns function.

;;; Revision 2.20 April 30, 2003 by JRF: Added the
;;; ADOLISP_FieldsPropertiesList global variable,
;;; containing the properties of the fields
;;; retrieved by the last SQL statement (if it
;;; was a SELECT statement).

;;; Revision 2.15 March 31, 2003 by JRF: ADOLISP_GetTablesAndViews
;;; contained a call to ErrorProcessor which should be
;;; ADOLISP_ErrorProcessor.

;;; Revision 2.14: documentation only.

;;; Revision 2.13 February 3, 2002 by JRF: Fixed a bug in
;;; ADOLISP_GetTablesAndViews which made it always return
;;; (nil nil) when the JET 4.0 driver was being used.

;;; Revision 2.12 May 27, 2002 by JRF: Documentation changes
;;; only, adding information on connecting to Excel to
;;; ADOLISP.DOC.

;;; Revision 2.11 March 14, 2001 by JRF: Fixed bug in
;;; releasing objects after trying to set the properties
;;; of the JET driver in ADOLISP_ConnectToDB

;;; Revision 2.1 March 9, 2002 by JRF: Added code to
;;; ADOLIST_ConnectToDB to set the Jet OLEDB:ODBC Parsing
;;; property to "true" when using the Jet engin, so SQL
;;; statements using double-quotes to surround delimited
;;; identifiers will work.

;; Load the ActiveX stuff for Visual LISP if it isn't already
;; loaded
(vl-load-com)

;;; In case this file gets compiled into a separate-namespace
;;; VLX, export the functions that should be visible.  The
;;; following has no effect unless the document is compiled
;;; into a separate-namespace VLX.

;;;(vl-doc-export 'adolisp_connecttodb)
;;;(vl-doc-export 'adolisp_dosql)
;;;(vl-doc-export 'adolisp_disconnectfromdb)
;;;(vl-doc-export 'adolisp_errorprinter)
;;;(vl-doc-export 'adolisp_gettablesandviews)
;;;(vl-doc-export 'adolisp_variant-value)

;;; Set up some variables that must be global (within
;;; this file)

;;; Define a VB data type that Visual LISP forgot
(if (not vlax-vbdecimal)
  (setq vlax-vbdecimal 14)
  ) ;_ end of if

;;; Set a flag if we are running in AutoCAD 2000 (not 2000i,
;;; 2002, ...)
(if (< (atof (getvar "ACADVER")) 15.05)
  (setq adolisp_isautocad2000 t)
  ) ;_ end of if

;; Import the ADO type library if it hasn't already been
;; loaded.
(if (null adomethod-append)
  (cond
    ;; If we can find the library in the registry ...
    ((and (setq adolisp_adodllpath
                 (vl-registry-read
                   "HKEY_CLASSES_ROOT\\ADODB.Command\\CLSID"
                   ) ;_ end of vl-registry-read
                ) ;_ end of setq
          (setq adolisp_adodllpath
                 (vl-registry-read
                   (strcat "HKEY_CLASSES_ROOT\\CLSID\\"
                           adolisp_adodllpath
                           "\\InProcServer32"
                           ) ;_ end of strcat
                   ) ;_ end of vl-registry-read
                ) ;_ end of setq
          (findfile adolisp_adodllpath)
          ) ;_ end of and
     ;; Import it
     (vlax-import-type-library
       :tlb-filename          adolisp_adodllpath     :methods-prefix
       "ADOMethod-"           :properties-prefix     "ADOProperty-"
       :constants-prefix      "ADOConstant-"
       ) ;_ end of vlax-import-type-library
 ;_ end of vlax-import-type-library
 ;_ end of vlax-import-type-library
 ;_ end of vlax-import-type-library
     )
    ;; Or if we can find it where we expect to find it ...
    ((setq adolisp_adodllpath
            (findfile
              (if (getenv "systemdrive")
                (strcat
                  (getenv "systemdrive")
                  "\\program files\\common files\\system\\ado\\msado15.dll"
                  ) ;_ end of strcat
                "c:\\program files\\common files\\system\\ado\\msado15.dll"
                ) ;_ end of if
              ) ;_ end of findfile
           ) ;_ end of setq
     ;; Import it
     (vlax-import-type-library
       :tlb-filename          adolisp_adodllpath     :methods-prefix
       "ADOMethod-"           :properties-prefix     "ADOProperty-"
       :constants-prefix      "ADOConstant-"
       ) ;_ end of vlax-import-type-library
 ;_ end of vlax-import-type-library
 ;_ end of vlax-import-type-library
 ;_ end of vlax-import-type-library
 ;_ end of vlax-import-type-library
 ;_ end of vlax-import-type-library
     )
    ;; Can't find the library, tell the user
    (t
     (alert
       (strcat "Cannot find\n\""
               (if adolisp_adodllpath
                 adolisp_adodllpath
                 "msado15.dll"
                 ) ;_ end of if
               "\""
               ) ;_ end of strcat
       ) ;_ end of alert
     )
    ) ;_ end of cond
  ) ;_ end of if

;;; A routine to connect to a database

;;; Arguments:
;;;     ConnectString:  Either the name of a .UDL file,
;;;                     including the ".UDL", or an
;;;                     OLEDB connection string.
;;;                     If this argument is the name of
;;;                     a UDL file without a full path,
;;;                     it is searched for in the
;;;                     current directory, the
;;;                     AutoCAD search path, and the
;;;                     AutoCAD Data Source Location.
;;;     UserName: The user name to use when connecting.
;;;               May be a null string if the user name is
;;;               specified in the first argument or the
;;;               first argument is a UDL file name.
;;;     Password: The password to use when connecting. 
;;                May be a null string if the password is
;;;               supplied in the first argument or the
;;;               first argument is a UDL file name.

;;; Return value:
;;;  If anything fails, NIL.  Call (ADOLISP_ErrorPrinter) to
;;;  print error messages to the command line.
;;;  Otherwise, an ADO Connection Object.

(defun adolisp_connecttodb (connectstring          username
                            password               /
                            isudl                  fulludlfilename
                            connectionobject       tempobject
                            returnvalue            connectionpropertiesobject
                            connectionparsingpropertyobject
                            )
  ;; Assume no error
  (setq adolisp_errorlist        nil
        adolisp_lastsqlstatement nil
        ) ;_ end of setq

  ;; If the connect string is a UDL file name ...
  (if (= ".UDL"
         (strcase
           (substr connectstring (- (strlen connectstring) 3))
           ) ;_ end of strcase
         ) ;_ end of =
    (progn
      ;; Set a flag that it's a UDL file
      (setq isudl t)
      ;; Try to find it
      (cond
        ((setq fulludlfilename (findfile connectstring)))
        ;; Didn't find it in the current directory or
        ;; the AutoCAD search path, try the AutoCAD
        ;; Data Source location
        ((setq fulludlfilename
                (findfile (strcat (vlax-get-property
                                    (vlax-get-property
                                      (vlax-get-property
                                        (vlax-get-acad-object)
                                        "Preferences"
                                        ) ;_ end of vlax-get-property
                                      "Files"
                                      ) ;_ end of vlax-get-property
                                    "WorkspacePath"
                                    ) ;_ end of vlax-get-property
                                  "\\"
                                  connectstring
                                  ) ;_ end of strcat
                          ) ;_ end of findfile
               ) ;_ end of setq
         )
        ;; Didn't find it, store an error message
        (t
         (setq adolisp_errorlist
                (list (list (cons "ADOLISP connection error"
                                  (strcat "Can't find \""
                                          connectstring
                                          "\""
                                          ) ;_ end of strcat
                                  ) ;_ end of cons
                            ) ;_ end of list
                      ) ;_ end of list
               ) ;_ end of setq
         )
        ) ;_ end of cond
      ) ;_ end of progn
    ) ;_ end of if

  ;; If the first argument is a UDL file name... ...
  (if isudl
    ;; If we found it ...
    (if fulludlfilename
      (progn
        ;; Create an ADO connection object
        (setq connectionobject
               (vlax-create-object
                 "ADODB.Connection"
                 ) ;_ end of vlax-create-object
              ) ;_ end of setq
        ;; Try to open the connection.  If there is an error
        ;; ...
        (if (vl-catch-all-error-p
              (setq tempobject
                     (vl-catch-all-apply
                       'vlax-invoke-method
                       (list connectionobject
                             "Open"
                             (strcat "File Name=" fulludlfilename)
                             username
                             password
                             adoconstant-adconnectunspecified
                             ) ;_ end of list
                       ) ;_ end of vl-catch-all-apply
                    ) ;_ end of setq
              ) ;_ end of vl-catch-all-error-p
          (progn
            ;; Save the error information
            (setq adolisp_errorlist
                   (adolisp_errorprocessor tempobject connectionobject)
                  ) ;_ end of setq
            ;; Release the connection object
            (vlax-release-object connectionobject)
            ) ;_ end of progn
          ;; It worked, store the connection object in our
          ;; return value
          (setq returnvalue connectionobject)
          ) ;_ end of if
        ) ;_ end of progn
      ) ;_ end of if
    ;; The connect string is not a UDL file name.
    (progn
      ;; Create an ADO connection object
      (setq connectionobject
             (vlax-create-object "ADODB.Connection")
            ) ;_ end of setq
      ;; Try to open the connection.  If there is an error ...
      (if (vl-catch-all-error-p
            (setq tempobject
                   (vl-catch-all-apply
                     'vlax-invoke-method
                     (list
                       connectionobject         "Open"
                       connectstring            username
                       password                 adoconstant-adconnectunspecified
                       ) ;_ end of list
 ;_ end of list
 ;_ end of list
 ;_ end of list
                     ) ;_ end of vl-catch-all-apply
                  ) ;_ end of setq
            ) ;_ end of vl-catch-all-error-p
        (progn
          ;; Save the error information
          (setq adolisp_errorlist
                 (adolisp_errorprocessor tempobject connectionobject)
                ) ;_ end of setq
          ;; Release the connection object
          (vlax-release-object connectionobject)
          ) ;_ end of progn
        ;; It worked, store the connection object in our
        ;; return value
        (setq returnvalue connectionobject)
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  ;; If we made a connection ...
  (if returnvalue
    (progn
      ;; Get the properties collection
      (setq connectionpropertiesobject
             (vlax-get-property
               returnvalue
               "Properties"
               ) ;_ end of vlax-get-property
            ) ;_ end of setq
      ;; If the properties collection has a "Jet OLEDB:ODBC
      ;; Parsing" item ...
      (if (not (vl-catch-all-error-p
                 (setq connectionparsingpropertyobject
                        (vl-catch-all-apply
                          'vlax-get-property
                          (list
                            connectionpropertiesobject
                            "ITEM"
                            "Jet OLEDB:ODBC Parsing"
                            ) ;_ end of list
                          ) ;_ end of vl-catch-all-apply
                       ) ;_ end of setq
                 ) ;_ end of vl-catch-all-error-p
               ) ;_ end of not
        ;; Set the "Jet OLEDB:ODBC Parsing" item to
        ;; "true" so the Jet engine accepts double-quotes
        ;; around delimited identifiers
        (vlax-put-property
          connectionparsingpropertyobject
          "VALUE"
          :vlax-true
          ) ;_ end of vlax-put-property
        ) ;_ end of if
      ;; And release our objects
      (if (= 'vla-object (type connectionparsingpropertyobject))
        (vlax-release-object connectionparsingpropertyobject)
        ) ;_ end of if
      (if (= 'vla-object (type connectionpropertiesobject))
        (vlax-release-object connectionpropertiesobject)
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  returnvalue
  ) ;_ end of defun

;;; A function to execute an arbitrary SQL statement
;;; (replacable parameters are not supported).

;;; Arguments:
;;;     ConnectionObject: An ADO Connection Object.
;;;     SQLString: the SQL statement to execute.

;;; Return value:

;;;  If anything fails, NIL.  Call (ADOLISP_ErrorPrinter) to
;;;  print error messages to the command line.  Otherwise:

;;;  If the SQL statement is a "select ..." statement that
;;;  could return rows, returns a list of lists.  The first
;;;  is a list of the column names.  If any rows were
;;;  returned, the subsequent sub-lists contain the
;;;  returned rows in the same order as the column names
;;;  in the first sub-list.

;;;  If the SQL statement is a "delete ...", "update ...", or
;;;  "insert ..." that cannot return any rows:
;;;    If the program is running in AutoCAD 2000, T
;;;    If the program is running in AutoCAD 2000i or
;;;    later, the integer number of rows affected.

(defun adolisp_dosql (connectionobject  sqlstatement      /
                      recordsetobject   fieldsobject      fieldnumber
                      fieldcount        fieldlist         recordsaffected
                      tempobject        returnvalue       commandobject
                      iserror           fielditem         fieldpropertieslist
                      fieldname
                      )
  ;; Assume no error
  (setq adolisp_errorlist
         nil
        ;; Initialize global variables
        adolisp_lastsqlstatement
         sqlstatement
        adolisp_fieldspropertieslist
         nil
        ) ;_ end of setq
  ;; If we are working in AutoCAD 2000 ...
  (if adolisp_isautocad2000
    ;; Then we can't use the Execute method of the Command
    ;; object because returning values in parameters (of a
    ;; function loaded from an external library) is broken.
    (progn
      ;; Create an ADO Recordset and set the cursor and lock
      ;; types
      (setq recordsetobject
             (vlax-create-object "ADODB.RecordSet")
            ) ;_ end of setq
      (vlax-put-property
        recordsetobject
        "cursorType"
        adoconstant-adopenkeyset
        ) ;_ end of vlax-put-property
      (vlax-put-property
        recordsetobject
        "LockType"
        adoconstant-adlockoptimistic
        ) ;_ end of vlax-put-property
      ;; Open the recordset.  If there is an error ...
      (if (vl-catch-all-error-p
            (setq tempobject
                   (vl-catch-all-apply
                     'vlax-invoke-method
                     (list recordsetobject    "Open"
                           sqlstatement       connectionobject
                           nil                nil
                           adoconstant-adcmdtext
                           ) ;_ end of list
 ;_ end of list
 ;_ end of list
 ;_ end of list
 ;_ end of list
 ;_ end of list
                     ) ;_ end of vl-catch-all-apply
                  ) ;_ end of setq
            ) ;_ end of vl-catch-all-error-p
        ;; Save the error information
        (progn
          (setq adolisp_errorlist
                 (adolisp_errorprocessor tempobject connectionobject)
                ) ;_ end of setq
          (setq iserror t)
          (vlax-release-object recordsetobject)
          ) ;_ end of progn
        ;; Otherwise, set an indicator that it worked
        (setq recordsaffected t)
        ) ;_ end of if
      ) ;_ end of progn
    ;; We're in AutoCAD 2000i or above, we can use the
    ;; Execute method of the Command object and see
    ;; how many records are affected by an UPDATE, INSERT,
    ;; or DELETE
    (progn
      ;; Create an ADO command object and store the query
      ;; and connection
      (setq commandobject (vlax-create-object "ADODB.Command"))
      (vlax-put-property
        commandobject
        "CommandText"
        sqlstatement
        ) ;_ end of vlax-put-property
      (vlax-put-property
        commandobject
        "ActiveConnection"
        connectionobject
        ) ;_ end of vlax-put-property
      ;; Create an ADO Recordset
      (setq recordsetobject
             (vlax-create-object "ADODB.RecordSet")
            ) ;_ end of setq
      ;; Open the recordset.  If there is an error ...
      (if (vl-catch-all-error-p
            (setq tempobject
                   (vl-catch-all-apply
                     'vlax-invoke-method
                     (list commandobject        "Execute"
                           'recordsaffected     nil
                           adoconstant-adcmdtext
                           ) ;_ end of list
 ;_ end of list
 ;_ end of list
 ;_ end of list
 ;_ end of list
 ;_ end of list
                     ) ;_ end of vl-catch-all-apply
                  ) ;_ end of setq
            ) ;_ end of vl-catch-all-error-p
        ;; Save the error information
        (progn
          (setq adolisp_errorlist
                 (adolisp_errorprocessor tempobject connectionobject)
                ) ;_ end of setq
          (setq iserror t)
          (vlax-release-object commandobject)
          (vlax-release-object recordsetobject)
          ) ;_ end of progn
        (progn
          ;; No error, save the recordset
          (setq recordsetobject tempobject)
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  ;; If there were no errors ...
  (if (not iserror)
    ;; If the recordset is closed ...
    (if (= adoconstant-adstateclosed
           (vlax-get-property recordsetobject "State")
           ) ;_ end of =
      ;; Then the SQL statement was a "delete ..." or an
      ;; "insert ..." or an "update ..." which doesn't
      ;; return any rows.
      (progn
        (setq returnvalue recordsaffected)
        ;; And release the recordset and command; we're done.
        (vlax-release-object recordsetobject)
        (if (not adolisp_isautocad2000)
          (vlax-release-object commandobject)
          ) ;_ end of if
        ) ;_ end of progn
      ;; The recordset is open, the SQL statement
      ;; was a "select ...".
      (progn
        ;; Get the Fields collection, which
        ;; contains the names and properties of the
        ;; selected columns
        (setq fieldsobject (vlax-get-property
                             recordsetobject
                             "Fields"
                             ) ;_ end of vlax-get-property
              ;; Get the number of columns
              fieldcount   (vlax-get-property fieldsobject "Count")
              fieldnumber  -1
              ) ;_ end of setq
        ;; For all the fields ...
        (while
          (> fieldcount (setq fieldnumber (1+ fieldnumber)))
           (setq fielditem           (vlax-get-property fieldsobject "Item" fieldnumber)
                 ;; Get the names of all the columns in a list to
                 ;; be the first part of the return value
                 fieldname           (vlax-get-property fielditem "Name")
                 fieldlist           (cons fieldname fieldlist)
                 fieldpropertieslist nil
                 ) ;_ end of setq
           (foreach fieldproperty '("Type"            "Precision"
                                    "NumericScale"    "DefinedSize"
                                    "Attributes"
                                    )
             (setq fieldpropertieslist
                    (cons (cons fieldproperty
                                (vlax-get-property
                                  fielditem
                                  fieldproperty
                                  ) ;_ end of vlax-get-property
                                ) ;_ end of cons
                          fieldpropertieslist
                          ) ;_ end of cons
                   ) ;_ end of setq
             ) ;_ end of foreach
           ;; Save the list in the global list
           (setq adolisp_fieldspropertieslist
                  (cons
                    (cons fieldname fieldpropertieslist)
                    adolisp_fieldspropertieslist
                    ) ;_ end of cons
                 ) ;_ end of setq
           ) ;_ end of while
        ;; Get the FieldsPropertiesList in the right order
        (setq adolisp_fieldspropertieslist
               (reverse adolisp_fieldspropertieslist)
              ) ;_ end of setq

        ;; Initialize the return value
        (setq returnvalue (list (reverse fieldlist)))
        ;; If there are any rows in the recordset ...
        (if
          (not (and (= :vlax-true
                       (vlax-get-property recordsetobject "BOF")
                       ) ;_ end of =
                    (= :vlax-true
                       (vlax-get-property recordsetobject "EOF")
                       ) ;_ end of =
                    ) ;_ end of and
               ) ;_ end of not
           ;; We're about to get tricky, hang on!  Create the
           ;; final results list ...
           (setq
             returnvalue
              ;; By appending the list of rows to the list of
              ;; fields.
              (append
                (list (reverse fieldlist))
                ;; Uses Douglas Wilson's elegant
                ;; list-transposing code from
                ;; http://xarch.tu-graz.ac.at/autocad/lisp/
                ;; to create the list of rows, because
                ;; GetRows returns items in column order
                (apply
                  'mapcar
                  (cons
                    'list
                    ;; Set up to convert a list of lists
                    ;; of variants to a list of lists of
                    ;; items that AutoLISP understands
                    (mapcar
                      '(lambda (inputlist)
                         (mapcar '(lambda (item)
                                    (adolisp_variant-value item)
                                    ) ;_ end of lambda
                                 inputlist
                                 ) ;_ end of mapcar
                         ) ;_ end of lambda
                      ;; Get the rows, converting them from
                      ;; a variant to a safearray to a list
                      (vlax-safearray->list
                        (vlax-variant-value
                          (vlax-invoke-method
                            recordsetobject
                            "GetRows"
                            adoconstant-adgetrowsrest
                            ) ;_ end of vlax-invoke-method
                          ) ;_ end of vlax-variant-value
                        ) ;_ end of vlax-safearray->list
                      ) ;_ end of mapcar
                    ) ;_ end of cons
                  ) ;_ end of apply
                ) ;_ end of append
             ) ;_ end of setq
           ) ;_ end of if
        ;; Close the recordset and release it and the
        ;; command
        (vlax-invoke-method recordsetobject "Close")
        (vlax-release-object recordsetobject)
        (if (not adolisp_isautocad2000)
          (vlax-release-object commandobject)
          ) ;_ end of if
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of if
  ;; And return the results
  returnvalue
  ) ;_ end of defun

;;; A function to close a connection and release
;;; the connection object.

;;; Argument:
;;;    An ADO Connection Object.

;;; Return value:
;;;    Always returns T

(defun adolisp_disconnectfromdb (connectionobject)
  (setq adolisp_errorlist        nil
        adolisp_lastsqlstatement nil
        ) ;_ end of setq
  (vlax-invoke-method connectionobject "Close")
  (vlax-release-object connectionobject)
  t
  ) ;_ end of defun

;;; ------------------------------------------------------------

;;; ADOLISP utility functions

;;; A function to print the list of errors generated
;;; by the ADOLISP_ErrorProcessor function.  The functions
;;; are separate so ADOLISP_ErrorProcessor can be called
;;; while a DCL dialog box is displayed and then
;;; ADOLISP_ErrorPrinter can be called after the dialog
;;; box has been removed.

;;; No arguments, no return value.

(defun adolisp_errorprinter ()
  (if adolisp_lastsqlstatement
    (prompt (strcat "\nLast SQL statement:\n\""
                    adolisp_lastsqlstatement
                    "\"\n\n"
                    ) ;_ end of strcat
            ) ;_ end of prompt
    ) ;_ end of if
  (foreach errorlist adolisp_errorlist
    (prompt "\n")
    (foreach erroritem errorlist
      (prompt
        (strcat (car erroritem) "\t\t" (cdr erroritem) "\n")
        ) ;_ end of prompt
      ) ;_ end of foreach
    ) ;_ end of foreach
  (prin1)
  ) ;_ end of defun

;;; A function to obtain the names of all
;;; the tables and views in a database.
;;; (Views are called "Queries" in Microsoft Access.)

;;; Argument:
;;;     ConnectionObject: An ADO Connection Object

;; Return value:
;;;  A list of two lists.
;;;  The first list contains the table names.
;;;  The second list contains the view names.

(defun adolisp_gettablesandviews (connectionobject
                                  /               tempobject
                                  tableslist      templist
                                  viewslist
                                  )
  (setq adolisp_errorlist        nil
        adolisp_lastsqlstatement nil
        ) ;_ end of setq
  (setq recordsetobject (vlax-create-object "ADODB.RecordSet"))
  ;; If we fail getting a recordset of the tables and views
  ;; ...
  (if (vl-catch-all-error-p
        (setq recordsetobject
               (vl-catch-all-apply
                 'vlax-invoke-method
                 (list
                   connectionobject
                   "OpenSchema"
                   adoconstant-adschematables
                   ) ;_ end of list
                 ) ;_ end of vl-catch-all-apply
              ) ;_ end of setq
        ) ;_ end of vl-catch-all-error-p
    ;; Save the error information
    (setq adolisp_errorlist
           (adolisp_errorprocessor recordsetobject connectionobject)
          ) ;_ end of setq
    (progn
      ;; Got the recordset!
      ;; We're about to get tricky, hang on!  Convert the
      ;; recordset object to a LISP list ...
      (setq
        templist
         ;; Uses Douglas Wilson's elegant
         ;; list-transposing code from
         ;; http://xarch.tu-graz.ac.at/autocad/lisp/
         ;; to create the list of rows, because
         ;; GetRows returns items in column order
         (apply
           'mapcar
           (cons
             'list
             ;; Set up to convert a list of lists
             ;; of variants to a list of lists of
             ;; items that AutoLISP understands
             (mapcar
               '(lambda (inputlist)
                  (mapcar '(lambda (item)
                             (adolisp_variant-value item)
                             ) ;_ end of lambda
                          inputlist
                          ) ;_ end of mapcar
                  ) ;_ end of lambda
               ;; Get the rows, converting them from
               ;; a variant to a safearray to a list
               (vlax-safearray->list
                 (vlax-variant-value
                   (vlax-invoke-method
                     recordsetobject
                     "GetRows"
                     adoconstant-adgetrowsrest
                     ) ;_ end of vlax-invoke-method
                   ) ;_ end of vlax-variant-value
                 ) ;_ end of vlax-safearray->list
               ) ;_ end of mapcar
             ) ;_ end of cons
           ) ;_ end of apply
        ) ;_ end of setq
      ;; Now filter out the system tables and
      ;; sort the tables and views into the
      ;; correct lists
      (foreach item templist
        (cond
          ((= (nth 3 item) "VIEW")
           (setq viewslist (cons (nth 2 item) viewslist))
           )
          ((= (nth 3 item) "TABLE")
           (setq tableslist (cons (nth 2 item) tableslist))
           )
          ) ;_ end of cond
        ) ;_ end of foreach
      ;; Close the recordset
      (vlax-invoke-method recordsetobject "Close")
      ) ;_ end of progn
    ) ;_ end of if
  (vlax-release-object recordsetobject)
  (list tableslist viewslist)
  ) ;_ end of defun

;;; A function to obtain the properties
;;; of the columns in a table.

;;; Arguments:
;;;     ConnectionObject: An ADO Connection Object
;;;     TableName: A string containing the table name.
;;;                Not case sensitive.

;;; Return value:
;;;  If nothing was found, NIL.
;;;  If columns were found for that table, a
;;;  list of lists, one sub-list for each column.
;;;  Each sub-list contains:
;;;     Column name
;;;      dotted-pair lists:
;;;         "Type" . OLEDB DataTypeEnum
;;;         "DefinedSize" . Maximum length
;;;                         (character data only)
;;;                         (0 if no maximum)
;;;         "Attributes" . OLEDB FieldAttributeEnum
;;;         "Precision" . number of digits (numerical
;;;                       columns only)
;;;         "Ordinal" . number of the column in the
;;;                     table (the first column is 1)

;;; The sub-lists in the return value will be in
;;; the same order as the ordinal values of the columns.


(defun adolisp_getcolumns (connectionobject                tablename
                           /               tempobject      templist
                           returnvalue
                           )
  (setq adolisp_errorlist
         nil
        adolisp_lastsqlstatement
         nil
        tablename (strcase tablename)
        ) ;_ end of setq
  (setq recordsetobject (vlax-create-object "ADODB.RecordSet"))
  ;; If we fail getting a recordset of all
  ;; the columns in the database ...
  (if (vl-catch-all-error-p
        (setq recordsetobject
               (vl-catch-all-apply
                 'vlax-invoke-method
                 (list
                   connectionobject
                   "OpenSchema"
                   adoconstant-adschemacolumns
                   ) ;_ end of list
                 ) ;_ end of vl-catch-all-apply
              ) ;_ end of setq
        ) ;_ end of vl-catch-all-error-p
    ;; Save the error information
    (setq adolisp_errorlist
           (adolisp_errorprocessor
             recordsetobject
             connectionobject
             ) ;_ end of ADOLISP_ErrorProcessor
          ) ;_ end of setq
    (progn
      ;; Got the recordset!
      ;; We're about to get tricky, hang on!  Convert the
      ;; recordset object to a LISP list ...
      (setq
        templist
         ;; Uses Douglas Wilson's elegant
         ;; list-transposing code from
         ;; http://xarch.tu-graz.ac.at/autocad/lisp/
         ;; to create the list of rows, because
         ;; GetRows returns items in column order
         (apply
           'mapcar
           (cons
             'list
             ;; Set up to convert a list of lists
             ;; of variants to a list of lists of
             ;; items that AutoLISP understands
             (mapcar
               '(lambda (inputlist)
                  (mapcar '(lambda (item)
                             (adolisp_variant-value item)
                             ) ;_ end of lambda
                          inputlist
                          ) ;_ end of mapcar
                  ) ;_ end of lambda
               ;; Get the rows, converting them from
               ;; a variant to a safearray to a list
               (vlax-safearray->list
                 (vlax-variant-value
                   (vlax-invoke-method
                     recordsetobject
                     "GetRows"
                     adoconstant-adgetrowsrest
                     ) ;_ end of vlax-invoke-method
                   ) ;_ end of vlax-variant-value
                 ) ;_ end of vlax-safearray->list
               ) ;_ end of mapcar
             ) ;_ end of cons
           ) ;_ end of apply
        ) ;_ end of setq
      ;; Close the recordset
      (vlax-invoke-method recordsetobject "Close")
      ;; Loop over all the columns
      (foreach columnlist templist
        ;; If this column belongs to the correct table ...
        (if (= tablename (strcase (nth 2 columnlist)))
          ;; Store its information
          (setq returnvalue
                 (cons
                   (list (nth 3 columnlist)
                         (cons "Type" (nth 11 columnlist))
                         (cons "DefinedSize"
                               (if (nth 13 columnlist)
                                 (fix (nth 13 columnlist))
                                 0
                                 ) ;_ end of if
                               ) ;_ end of cons
                         (cons "Attributes"
                               (if (nth 9 columnlist)
                                 (fix (nth 9 columnlist))
                                 0
                                 ) ;_ end of if
                               ) ;_ end of cons
                         (cons "Precision"
                               (if (nth 15 columnlist)
                                 (nth 15 columnlist)
                                 255
                                 ) ;_ end of if
                               ) ;_ end of cons
                         (cons "Ordinal"
                               (fix (nth 6 columnlist))
                               ) ;_ end of cons
                         ) ;_ end of list
                   returnvalue
                   ) ;_ end of cons
                ) ;_ end of setq
          ) ;_ end of if
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (vlax-release-object recordsetobject)

  ;; The reverse of the return value list is probably in order, but make sure
  ;; ....
  (if returnvalue
    (vl-sort (reverse returnvalue)
             '(lambda (x y)
                (< (cdr (assoc "Ordinal" (cdr x)))
                   (cdr (assoc "Ordinal" (cdr y)))
                   ) ;_ end of <
                ) ;_ end of lambda
             ) ;_ end of vl-sort
    nil
    ) ;_ end of if
  ) ;_ end of defun


;;; ------------------------------------------------------------

;;; ADOLISP Support functions

;;; A function to assemble all errors into a list of lists of
;;; dotted pairs of strings ("name" . "value")

(defun adolisp_errorprocessor (vlerrorobject    connectionobject
                               /                errorsobject
                               errorobject      errorcount
                               errornumber      errorlist
                               errorvalue
                               )
  ;; First get Visual LISP's error message
  (setq returnlist   (list
                       (list
                         (cons
                           "Visual LISP message"
                           (vl-catch-all-error-message vlerrorobject)
                           ) ;_ end of cons
                         ) ;_ end of list
                       ) ;_ end of list
        ;; Get the ADO errors object and quantity
        errorobject  (vlax-create-object "ADODB.Error")
        errorsobject (vlax-get-property connectionobject "Errors")
        errorcount   (vlax-get-property errorsobject "Count")
        errornumber  -1
        ) ;_ end of setq
  ;; Loop over all the ADO errors ...
  (while (< (setq errornumber (1+ errornumber)) errorcount)
    ;; Get the error object of the current error
    (setq errorobject
                      (vlax-get-property errorsobject "Item" errornumber)
          ;; Clear the list of items for this error
          errorlist   nil
          ) ;_ end of setq
    ;; Loop over all possible error items of this error
    (foreach errorproperty '("Description"    "HelpContext"    "HelpFile"
                             "NativeError"    "Number"         "SQLState"
                             "Source"
                             )
      ;; Get the value of the current item.  If it's a number
      ;; ...
      (if (numberp (setq errorvalue
                          (vlax-get-property errorobject errorproperty)
                         ) ;_ end of setq
                   ) ;_ end of numberp
        ;; Convert it to a string for consistency
        (setq errorvalue (itoa errorvalue))
        ) ;_ end of if
      ;; And store it
      (setq errorlist (cons (cons errorproperty errorvalue)
                            errorlist
                            ) ;_ end of cons
            ) ;_ end of setq
      ) ;_ end of foreach
    ;; Add the list for the current error to the return value
    (setq returnlist (cons (reverse errorlist) returnlist))
    ) ;_ end of while
  ;; Set up the return value in the correct order
  (reverse returnlist)
  ) ;_ end of defun

;;; A function to convert a variant to a value.  Knows
;;; about more variant types than vlax-variant-value

(defun adolisp_variant-value (variantitem / varianttype)
  (cond
    ;; If it's a Currency data type or a Decimal data type ...
    ((or (= vlax-vbcurrency
            (setq varianttype (vlax-variant-type variantitem))
            ) ;_ end of =
         ;; Note that I defined vlax-vbDecimal
         ;; at the beginning of the file
         (= vlax-vbdecimal varianttype)
         ) ;_ end of or
     ;; Convert it to a double before getting its value
     (vlax-variant-value
       (vlax-variant-change-type variantitem vlax-vbdouble)
       ) ;_ end of vlax-variant-value
     )
    ;; If it's a date, time, or date/time variable type ...
    ((= vlax-vbdate varianttype)
     ;; Convert it to a string (assuming it's a Microsoft
     ;; Access type Julian date)
     (1900basedjuliantocalender
       (vlax-variant-value variantitem)
       ) ;_ end of 1900BasedJulianToCalender
     )
    ;; If it's a boolean value (yes/no, true/false, ...) ...
    ((= vlax-vbboolean varianttype)
     ;; Convert it to the string "True" or "False"
     (if (= :vlax-true (vlax-variant-value variantitem))
       "True"
       "False"
       ) ;_ end of if
     )
    ;; If it's an OLE_COLOR data type ...
    ((= vlax-vbole_color varianttype)
     ;; Convert it to a long integer before getting its value
     (vlax-variant-value
       (vlax-variant-change-type variantitem vlax-vblong)
       ) ;_ end of vlax-variant-value
     )
    ;; Otherwise, just turn vlax-variant-value loose on it
    (t (vlax-variant-value variantitem))
    ) ;_ end of cond
  ) ;_ end of defun

;;; A function to convert a "1900-based"Julian-like
;;; date, time, or date/time to a string.

;;; Argument:  A real number, containing a Julian-type date
;;; based on January 1, 1900 (e.g. a Microsoft Access date)
;;; in the integer portion and a time (as a fraction of a
;;; day) in the fractional portion.  Note that this
;;; algorithm considers a number with no fractional
;;; portion to be the day _starting_ at midnight.

;;; Return Value:  A string:
;;;  Containing just the date if there was no fractional
;;;    portion.
;;;  Containing just the time if there was no integer portion
;;;    or the input number was 0.0
;;;  Otherwise, containing the date and the time.

;;; Times are returned as hour:minutes:seconds, 24-hour
;;; format, with leading zeros if necessary to make
;;; two digits per element

;;; Dates are returned in US format (month/day/year) but this
;;; is easily changed.  The year is given as four digits.
;;; The month and day are supplied as two digits (possibly
;;; with leading zeros)

(defun 1900basedjuliantocalender (juliandate        /        a        b
                                  c        d        e        y        z
                                  month    day      year     hours    minutes
                                  seconds  calendertime      notime   nodate
                                  returnvalue
                                  )
  ;; Initialize the return value
  (setq returnvalue "")
  ;; If the input date has no time component ...
  (if (equal 0.0
             (float (- juliandate (float (fix juliandate))))
             1E-9
             ) ;_ end of equal
    ;; It has no time component ... if it has no date
    ;; component ...
    (if (zerop (fix juliandate))
      ;; It must be a timestamp of 0:00.00.  Set the flag that
      ;; we don't have a date but leave the "No Time" flag
      ;; unset
      (setq nodate t)
      ;; It has a date component but has no time component.
      ;; Shift the date to a real Julian date
      (setq juliandate (+ 2415019 (fix juliandate))
            ;; Set a flag so we know we don't have to
            ;; calculate the time
            notime     t
            ) ;_ end of setq
      ) ;_ end of if
    ;; It has a time component.  If it has no date component
    ;; ...
    (if (zerop (fix juliandate))
      ;; Set a flag so we know we don't want to calculate a
      ;; date
      (setq nodate t)
      ;; Otherwise, just shift it to be based like a standard
      ;; Julian date
      (setq juliandate (+ 2415019 juliandate))
      ) ;_ end of if
    ) ;_ end of if
  ;; If we want to calculate the date ...
  (if (not nodate)
    ;; It's magic, don't even ask (because I don't know).
    ;; Some things we weren't meant to know.
    (setq z           (fix juliandate)
          a           (fix (/ (- z 1867216.25) 36524.25))
          a           (+ z 1 a (- (fix (/ a 4))))
          b           (+ a 1524)
          c           (fix (/ (- b 122.1) 365.25))
          d           (floor (* 365.25 c))
          e           (fix (/ (- b d) 30.6001))
          day         (fix (- b d (floor (* 30.6001 e))))
          e           (- e
                         (if (< e 14)
                           2
                           14
                           ) ;_ end of if
                         ) ;_ end of -
          month       (1+ e)
          year        (if (> e 1)
                        (- c 4716)
                        (- c 4715)
                        ) ;_ end of if
          year        (if (= year 0)
                        (1- year)
                        year
                        ) ;_ end of if
          ;; This uses US format for the date, you might want
          ;; to change it.
          returnvalue (strcat (if (< month 10)
                                (strcat "0" (itoa month))
                                (itoa month)
                                ) ;_ end of if
                              "/"
                              (if (< day 10)
                                (strcat "0" (itoa day))
                                (itoa day)
                                ) ;_ end of if
                              "/"
                              (itoa year)
                              ) ;_ end of strcat
          ) ;_ end of setq
    ) ;_ end of if
  ;; If we want to calculate the time ...
  (if (not notime)
    ;; First strip the date portion from the input
    (setq y            (- juliandate (float (fix juliandate)))
          ;; Round to the nearest second
          y            (/ (float (fix (+ 0.5 (* y 86400.0)))) 86400.0)
          ;; Number of hours since midnight
          hours        (fix (* y 24))
          ;; Number of minutes since midnight the hour
          ;; (1440 minutes per day)
          minutes      (fix (- (* y 1440.0) (* hours 60.0)))
          ;; Number of seconds since the minute (86400
          ;; seconds per day)
          seconds      (fix (- (* y 86400.0)
                               (* hours 3600.0)
                               (* minutes 60.0)
                               ) ;_ end of -
                            ) ;_ end of fix
          calendertime (strcat (if (< hours 10)
                                 (strcat "0" (itoa hours))
                                 (itoa hours)
                                 ) ;_ end of if
                               ":"
                               (if (< minutes 10)
                                 (strcat "0" (itoa minutes))
                                 (itoa minutes)
                                 ) ;_ end of if
                               ":"
                               (if (< seconds 10)
                                 (strcat "0" (itoa seconds))
                                 (itoa seconds)
                                 ) ;_ end of if
                               ) ;_ end of strcat
          returnvalue  (if (< 0 (strlen returnvalue))
                         (strcat returnvalue " " calendertime)
                         calendertime
                         ) ;_ end of if

          ) ;_ end of setq
    ) ;_ end of if
  returnvalue
  ) ;_ end of defun

;;; Floor function, rounds down to the next integer.
;;; Identical with FIX for positive numbers, but
;;; rounds away from zero for negative numbers.

(defun floor (number /)
  (if (> number 0)
    (fix number)
    (fix (- number 1))
    ) ;_ end of if
  ) ;_ end of defun

(prompt "\nADOLISP library loaded")

Вроде я там ничего не правил, если что-то работать не будет, сообщи.

[Cleper]

Спасибо попробую на днях.

Если что отпишусь.

[Саша_Лебедев]

Господи ты боже мой!
На VBA - три строчки делов, что вы творите?

[Кулик Алексей aka kpblc]

> Саша_Лебедев все хорошо, если бы не было все не так хорошо.
1. Поддержка VBA в ACAD'e может быть отключена.
2. Передать значения из VBA в лисп и обратно достаточно геморройно.
3. При запуске внешнего СОМ-сервера могут возникнуть проблемы с коннектом к БД (особенно если отслеживается имя и пароль пользователя).
4. При запуске внутреннего соединения требуется, чтоб на машине клиента были установлены и зарегистрированы библиотеки ADO, чего бывает далеко не всегда.
добавлено: Я лично вчера с таким столкнулся на виртуальной машине с чистым ACAD 2005. dbconnect еще не запускался
И, наконец, последнее. Строчек будет явно не 3 (говорю на основе "чистого" VB). Надо использовать раннее связывание с ADO; потом создавать коннект (уже 2 строки как минимум - одна создать объект коннекта; вторая - установить соединение; я молчу про указание типа курсора и блокировки: подобные вещи, как правило, задаются руками и не отдаются на откуп "автомату"). После создания коннекта надо объявлять рекордсет (еще 2 строки как минимум) и проходить по его результатам.
В общем (ИМХО!!!) не все так радужно
---
Добавлено: прежде чем закидывать меня гнилыми пидоморами, прошу прочесть мою подпись - я не бог и могу ошибаться.
---
Добавлено 2:
Кроме того, к БД можно получить доступ как минимум 3 способами: ADO, RDO, DAO. А еще есть ADO.NET и прочая Код, который здесь, корректно работает с многопользовательскими БД, и не вызывает лично у меня никаких вопросов.

[VVA]

Автор не я, стырено было с сайта флемингов (давно там не был, может, и заработало).

Вроде ожили.
http://acad.fleming-group.com/

[Кулик Алексей aka kpblc]

Yes! Зер гуд!

[Елпанов Евгений]

Сообщение от Саша_Лебедев Господи ты боже мой! На VBA - три строчки делов, что вы творите?

Если без всяких наворотов и проверок, то из лиспа и VBA (по количеству строк), будет примерно одинаково...
На VBA можно опустить некоторые вещи, но придется объявлять все переменные...
Итого, равноценный код будет одинаковым по объему

[ShaggyDoc]

По поводу "меряния строками".

1. kpblc привел исходники целой библиотеки. Когда они спрятаны, то конечная программа превращается в несколько строк. В VBA все "строки" с библиотечными процедурами и функциями также есть. То, что они не видны, не значит, что они не выполняются.

2. Эти "несколько строк" можно превратить в одну. Убрать комментарии и переводы строк и только. :wink:


3. Пример показывает, как на языке, в котором изначально нет абсолютно никаких средств для работы с БД, можно это сделать. Фактически приведен код для расширения самого языка.

4. Пусть кто-нибудь попробует на VBA написать код, заменяющий вот это:

Код:

[Выделить все]

(apply 'mapcar (cons 'list lst))

В приведенной библиотеке этот кусок используется

Код:

[Выделить все]

 ;; Uses Douglas Wilson's elegant 
 ;; list-transposing code from 
 ;; http://xarch.tu-graz.ac.at/autocad/lisp/ 
 ;; to create the 00000 rows, because 
 ;; GetRows returns items in column order

только без объявления переменных, а передачей результатов других функций.

Эта маленькая строчка транспонирует таблицу, то есть меняет местами ряды и колонки. Можно поэкспериментировать, сколько страниц займет код для получения аналогичного результата на любом "нефункциональном" языке, с использованием его базовых, штатных средств без подключения каких-нибудь библиотек.

[fixo]

Сообщение от Cleper Народ подскажите как получить доступ к таблицам БД Access? Допустим есть таблица CLEPER в базе Access. Как мне к ней обратиться чтобы можно было извлечь данные!

Не люблю как-то возиться с библиотеками, может это
по-деревенски но работает
Измени название таблицы (отмечено)

Код:

[Выделить все]

(defun ARD (/ ADOcn ADOrst DBname RowData SQLstr)
  (vl-load-com)

  (setq
    DBname
	   (getfiled "Select an Access Database File"
		     (getvar "dwgprefix")
		     "mdb"
		     4
	   )

    ADOcn
	   (vlax-create-object "ADODB.Connection")
    ADOrst
	   (vlax-create-object "ADODB.Recordset")
  )
  (vlax-invoke-method
    ADOcn
    "Open"
    (strcat "Driver={Microsoft Access Driver (*.mdb)}; DBQ="
	    DBname
    )
    T
    T
    T
  )
  (setq	SQLstrRead
	 " SELECT * FROM RenameLayers"
  )					; -> RenameLayers - название таблицы

  (vlax-invoke-method ADOrst "Open" SQLstrRead ADOcn -1 3 1)
  (setq RowData (vlax-invoke-method ADOrst "GetRows" T))
  (setq	TableData
	 (apply
	   'mapcar
	   (cons
	     'list
	     (mapcar
	       (function
		 (lambda (x)
		   (mapcar (function (lambda (y)
				       (vlax-variant-value y)
				     )
			   )
			   x
		   )
		 )
	       )
	       (vlax-safearray->list (vlax-variant-value RowData))
	     )
	   )
	 )
  )
  (vlax-invoke-method ADOrst "Close")
  (vlax-invoke-method ADOcn "Close")
  (mapcar
    (function
      (lambda (x)
	(vl-catch-all-apply
	  (function
	    (lambda ()
	      (progn
		(vlax-release-object x)
		(setq x nil)
	      )
	    )
	  )
	)
      )
    )
    (list ADOrst ADOcn)
  )
  (gc)
  TableData
)

; TesT : (setq data (ard))

~'J'~

[Name]

Кулик Алексей aka kpblc

А можно маленький примерчик использования библиотеки?
А то ничего не получается.

Заранее спасибо

[Кулик Алексей aka kpblc]

Поперше всего, прошу прощения - в нижеприведенном коде используются мои библиотечные функции, я их не привожу, поскольку не в них вопрос. Если понадобится - сигнализируй, попробую отфасовать
Есть несколько вариантов работы, зависит от количества выполняемых запросов. Если запросов не 1, и выполняются они один за другим, то можно сделать так:
- сначала создаем объект связи с БД:

Код:

[Выделить все]

(defun _kpblc-db-connect (db-file-path)
                         ;|
*    Функция-"обертка" для adolisp_connecttodb для mdb-файлов.
* Возвращает объект связи с БД.
*    Параметры вызова:
*	db-file-path	- полный путь к БД
*    Примеры вызова:
(_kpblc-db-connect "h:\\_database\\kpblc_dtl_equip.mdb")
|;
  (if (findfile db-file-path)
    (adolisp_connecttodb
      (strcat "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
              db-file-path
              ";Persist Security Info=False"
              ) ;_ end of strcat
      "Admin"
      ""
      ) ;_ end of adolisp_connecttodb
    ) ;_ end of if
  ) ;_ end of defun

Затем выполняем запрос:

Код:

[Выделить все]

(defun _kpblc-db-sql-opened-connect (conn sql / conn res)
                                    ;|
*    Функция-"обертка" для выполнения SQL-запросов к БД при открытом Connection
* и без его закрытия
*    Возвращаемое значение:
*	- для запроса типа SELECT .. FROM .. WHERE список вида
'(
("ID" "ParentID" "Group" "TreeKey" "img_file" "tblName" "FuncName" "BlockLibName")
(1 1 "Оборудование" "equip" nil nil nil nil)
)
*    Первый элемент - список полей
*    Последующие элементы - список значений

*    Параметры вызова:
*	conn		- объект "Connection"
*	sql		- строка SQL-запроса
*    Примеры вызова:
(_kpblc-db-sql "h:\\_database\\kpblc_dtl_equip.mdb" "SELECT * FROM _tblSysGroups")
(_kpblc-db-sql "v:\\main_db.mdb" (strcat "SELECT [_tblSysBlockForSpecRename].SpecName, ""
	"* FROM _tblSysBlockForSpecRename WHERE "
	"(((LCase([_tblSysBlockForSpecRename]![BlockName]))=\"эо_однопол2\"));"))
|;
  (setq res (adolisp_dosql conn (_kpblc-string-replace sql "\"" "'")))
  ;; В SQL-запросе меняем " на '
  (if (and adolisp_errorlist
           (_kpblc-is-debug-mode)
           ) ;_ end of and
    (_kpblc-error-print
      (strcat (car (_kpblc-string-parser sql "("))
              " <...> : "
              (cdr (_kpblc-assoc "description" (cadr adolisp_errorlist)))
              ) ;_ end of strcat
      nil
      ) ;_ end of _kpblc-error-print
    ) ;_ end of if
  res
  ) ;_ end of defun

И закрываем коннект:

Код:

[Выделить все]

(defun _kpblc-db-disconnect (connect)
                            ;|
*    Функция-"обертка" для разрыва соединения с БД.
*    Возвращаемое значение: нет
*    Параметры вызова:
*	connect	- объект связи
*    Примеры вызова:
(_kpblc-db-disconnect *db*)
|;
  (_kpblc-error-catch
    '(lambda ()
       (adolisp_disconnectfromdb connect)
       ) ;_ end of lambda
    nil
    ) ;_ end of _kpblc-error-catch
  ) ;_ end of defun

---
Если же запрос всего один, то можно сделать по-другому:

Код:

[Выделить все]

(defun _kpblc-db-sql (db-file-path sql / conn res)
                     ;|
*    Функция-"обертка" для выполнения SQL-запросов к БД.
*    Возвращаемое значение:
*	- для запроса типа SELECT .. FROM .. WHERE список вида
'(
("ID" "ParentID" "Group" "TreeKey" "img_file" "tblName" "FuncName" "BlockLibName")
(1 1 "Оборудование" "equip" nil nil nil nil)
)
*    Первый элемент - список полей
*    Последующие элементы - список значений

*    Параметры вызова:
*	db-file-path	- путь к БД mdb
*	sql		- строка SQL-запроса
*    Примеры вызова:
(_kpblc-db-sql "h:\\_database\\kpblc_dtl_equip.mdb" "SELECT * FROM _tblSysGroups")
(_kpblc-db-sql "v:\\main_db.mdb" (strcat "SELECT [_tblSysBlockForSpecRename].SpecName, "
		"* FROM _tblSysBlockForSpecRename WHERE "
		"(((LCase([_tblSysBlockForSpecRename]![BlockName]))=\"эо_однопол2\"));"))
|;
  (if (setq conn (_kpblc-db-connect db-file-path))
    (progn
      (setq res (adolisp_dosql conn (_kpblc-string-replace sql "\"" "'")))
      ;; В SQL-запросе меняем " на '
      (if adolisp_errorlist
        (foreach item adolisp_errorlist
          (princ (strcat "\n" (vl-princ-to-string item)))
          ) ;_ end of foreach
        ) ;_ end of if
      (_kpblc-db-disconnect conn)
      ) ;_ end of progn
    ) ;_ end of if
  res
  ) ;_ end of defun

===
Как видишь, все равно создается объект связи с БД, потом работаем внутри этого объекта, и закрываем связь с БД. По крайней мере, пока я делаю так.

[john644]

Почему-то у меня на2013 автокаде adolisp_connecttodb выдает no function хотя дорогу файла находит vlax-invoke-method тоже не хочет работать

[Кондратьев_Роман]

Бьюсь уже неделю над проблемой подключения к Access 2010 (локальная БД, без пароля). Совсем извёлся, руки опускаются..
Подскажите, может есть нюансы какие-то именно касаемо 2010?
Не открывается объект ADO Connection. Всё перелопатил. Пишет - Ошибка Automation. Не удается запустить приложение. Системная база данных отсутствует или открыта с монопольным доступом другим пользователем.
Делаю всё стандартно:
----------
(setq Объект_Connection (vlax-create-object "ADODB.Connection"))
(vlax-invoke-method Объект_Connection "Open" "Provider=Microsoft.ACE.OLEDB.12.0;DataSource=D:\\Работа\\САПР_ХНС\\ХимНефтеСтрой.accdb" T T T) ;;;;;
-----------
Может дело в трёх Т ? Но в примерах именно так..
Подозреваю, что дело в Access-овских наворотах.. Что делать?? И кто виноват

[trir]

разрядность?

[Кондратьев_Роман]

64. и офис, и винда (10-ка), и акад-2015

[trir]

http://programmersforum.ru/showthread.php?t=207711
http://www.sql.ru/forum/105441/sp-ad...yh-otsutstvuet

[ShaggyDoc]

Сообщение от Кондратьев_Роман "Provider=Microsoft.ACE.OLEDB.12.0;DataSource=D:\\Работа\\САПР_ХНС\\ХимНефтеСтрой.accdb"

В этом месте строка (не лисповская). А базы данных с двумя слэшами в полном имени файла в операционной системе нет. Поэтому и выдает ошибку.

И вообще в подобных случаях надо просто пытаться соединяться с БД не из Лиспа, а в диалоге. Тогда будут понятны и загадочные T T T