Lisp调用ARX与Sqlite通信

admin1

Lisp调用ARX与Sqlite通信



(DEFUN $DO-SQL-sqlite-arx$
       (LST / $shi-wu-arx$ a db-path err jgs sqls swzt)
       ;|;调用方法1(先开启事务，然后逐条传送，最后调用关闭方法)
($DO-SQL-sqlite-arx$ '(("接口" . "Update") ("数据库路径" . "D:\\文档\\ZXCAD_DB\\2021-9-18-19-31-00.db") ("Sql" "insert into wl values(?,?,?,?)") ("返回格式") ("启用事务" . "是") ("事务状态" . "开启")))
(mapcar    (function (lambda (a)
            ($DO-SQL-sqlite-arx$
              (list
            (cons "接口" "Update")
            (cons "数据库路径" db-path)
            (cons "Sql" (list a))
            (cons "返回格式" nil)
            (CONS "启用事务" "是")
            (CONS "事务状态" "挂起")
              )
            )
          )
    )
    (cdr sqls)
)
($DO-SQL-sqlite-arx$ '(("接口" . "Update") ("数据库路径" . "D:\\文档\\ZXCAD_DB\\2021-9-18-19-31-00.db") ("Sql") ("返回格式") ("启用事务" . "是") ("事务状态" . "关闭")))
|;

       ;|;调用方法2(直接传递sql语句后自己调用关闭方法)（数据量巨大的时候，拼接很多sql语句占用内存，会提示冲突）
($DO-SQL-sqlite-arx$ '(("接口" . "Update") ("数据库路径" . "D:\\文档\\ZXCAD_DB\\2021-9-18-19-31-00.db") ("Sql" "insert into wl values(?,?,?,?)" ("连接器" "AVSS" "0.5" "35") ("连接器" "AVSS" "0.5" "35r") ("连接器" "AVSS" "0.5" "35t") ("连接器" "AVSS" "0.5" "35y")) ("返回格式") ("启用事务" . "是") ("事务状态" . "开启")))
($DO-SQL-sqlite-arx$ '(("接口" . "Update") ("数据库路径" . "D:\\文档\\ZXCAD_DB\\2021-9-18-19-31-00.db") ("Sql") ("返回格式") ("启用事务" . "是") ("事务状态" . "关闭")))
|;
       ;|;调用方法3(直接传递sql语句)（数据量巨大的时候，拼接很多sql语句占用内存，会提示冲突）
($DO-SQL-sqlite-arx$ '(("接口" . "Update") ("数据库路径" . "D:\\文档\\ZXCAD_DB\\2021-9-18-19-31-00.db") ("Sql" "insert into wl values(?,?,?,?)" ("连接器" "AVSS" "0.5" "35") ("连接器" "AVSS" "0.5" "35r") ("连接器" "AVSS" "0.5" "35t") ("连接器" "AVSS" "0.5" "35y")) ("返回格式") ("启用事务" . "是")))
|;
  (DEFUN $shi-wu-arx$ (jzs swzt / err sqls)
                    ;注意：矩阵数据的第一条数据格式："insert into Test2 values(?,?,?,?)"，这里的问号代表数据库字段名
    (cond ((= swzt "挂起")
       (if (and jzs
            (= (type jzs) 'list)
            (= (type (car jzs)) 'list)
            (not (= (type (car (car jzs))) 'list))
           )            ;必须是矩阵字串，事务的时候需要预编译
         (mapcar (function (lambda (jz)
                 (eval (cons 'DSQL_STMTBIND jz))
                   )
             )
             jzs
         )
       )
      )
      ((= swzt "开启")
       (DSQL_CLOSEALL DB-PATH)
       (DSQL_OPEN DB-PATH)
       (DSQL_DML DB-PATH "begin transaction;")
       (if (and (= (type jzs) 'list)
            (= (type (car jzs)) 'str) ;第一条必须是字串型
           )
         (DSQL_CMPSTMT DB-PATH (car jzs))
       )
       (if (and jzs
            (= (type (cdr jzs)) 'list)
            (= (type (car (cdr jzs))) 'list)
            (not (= (type (car (car (cdr jzs)))) 'list))
           )            ;必须是矩阵字串，事务的时候需要预编译
         (mapcar (function (lambda (jz)
                 (eval (cons 'DSQL_STMTBIND jz))
                   )
             )
             (cdr jzs)
         )
       )
      )
      ((= swzt "关闭")
       (DSQL_DML DB-PATH "commit transaction;")
       (DSQL_STMTFNL)
       (setq err (DSQL_LASTERR))
       (DSQL_CLOSE DB-PATH t)
       (DSQL_CLOSEALL DB-PATH)
      )
      (t
       (DSQL_CLOSEALL DB-PATH)
       (DSQL_OPEN DB-PATH)
       (DSQL_DML DB-PATH "begin transaction;")
                    ; this is our compiled statement, we will bind data to ?
       (DSQL_CMPSTMT DB-PATH (car jzs))
                    ; Bind OUR VALUES
       (if (and jzs
            (= (type jzs) 'list)
            (= (type (car jzs)) 'str) ;第一条必须是字串型
            (= (type (car (cdr jzs))) 'list)
            (= (type (car (car (cdr jzs)))) 'str)
           )            ;必须是矩阵字串，事务的时候需要预编译
         (mapcar (function (lambda (jz)
                 (eval (cons 'DSQL_STMTBIND jz))
                   )
             )
             (cdr jzs)
         )
       )
                    ; COMMIT THE TRANSACTION
       (DSQL_DML DB-PATH "commit transaction;")
                    ; We must call this to clear the compiled statement
                    ; and finalize the transaction
       (DSQL_STMTFNL)
       (setq err (DSQL_LASTERR))
       (DSQL_CLOSE DB-PATH t)
       (DSQL_CLOSEALL DB-PATH)
      )
    )
  )

  (SETQ DB-PATH (cdr (assoc "数据库路径" lst)))
  (setq sqls (cdr (assoc "Sql" lst)))
  (if (= (type sqls) 'str)
    (setq sqls (list sqls))
  )
  (setq swzt (cdr (assoc "事务状态" lst)))
  (cond    ((and (= (cdr (assoc "启用事务" lst)) "是"))
     ($shi-wu-arx$ sqls swzt)    ;sqls必须是矩阵字串，事务的时候需要预编译
    )                ;测试了insert into
    (t
     (DSQL_CLOSEALL DB-PATH)
     (DSQL_OPEN DB-PATH)
     (cond ((= (cdr (assoc "接口" lst)) "Update")
        (setq jgs
               (mapcar
             (function (lambda (sql)
                     (DSQL_DML DB-PATH sql)
                   )
             )
             sqls
               )
        )
           )
           ((= (cdr (assoc "接口" lst)) "Query")
        (setq jgs
               (mapcar
             (function (lambda (sql)
                     (if (member (cdr (assoc "返回格式" lst))
                         (list "jz" "JZ" "矩阵" "野鸡格式")
                     )
                       (DSQL_QUERY DB-PATH sql)
                       (DSQL_ASSOCQUERY DB-PATH sql)
                     )
                   )
             )
             sqls
               )
        )
           )
     )
     (setq err (DSQL_LASTERR))
     (DSQL_CLOSE DB-PATH t)
     (DSQL_CLOSEALL DB-PATH)
    )
  )
  (setq jgs (vl-remove nil jgs))
  (cond    ((member (cdr (assoc "返回格式" lst))
         (list "jz" "JZ" "矩阵" "野鸡格式")
     )
     (if (and (= (type jgs) 'list)
          (= (type (car jgs)) 'list)
          (= (type (car (car jgs))) 'list)
          (= (type (car (car (car jgs)))) 'str)
         )
       (setq jgs (apply 'append jgs))
     )
    )
    (t
     (if (and (= (type jgs) 'list)
          (= (type (car jgs)) 'list)
          (= (type (car (car jgs))) 'list)
          (= (type (car (car (car jgs)))) 'list)
         )
       (setq jgs (apply 'append jgs))
     )
    )
  )
  jgs
)