设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 312|回复: 7

[原创] lisp通过Go发送Sql语句访问Sqlite数据库

[复制链接]
发表于 2020-1-9 20:51:00 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
本帖最后由 dcl1214 于 2020-1-11 10:13 编辑

经过测试,lisp可以通过GO访问sqlite数据库,速度非常快,所以,现在将工具分享出来

附件里面有一个data数据库和一个sqlite.exe程序,sqlite.exe是Go语言开发的,您只需要将两个文件放在一个目录下面就好了,exe双击启动后会自己找到db数据库文件
exe启动后会在注册表中HKEY_CURRENT_USER\ZXCAD\Server_Client\loc位置写明端口号和exe的路径,程序默认从8000端口开始扫描,如果8000端口被占用,程序会使用8001,如果8001被占用,程序会找8002,依次类推

exe支持32位系统和64位系统通吃,不依赖系统任何组件,例如:不依赖vcruntime,不依赖.net,只要您的电脑能开机就能正常运行

启动程序后会在任务管理器里面看到sqlite通信的任务



目前接口支持了三个:test Query Update
       test返回基本信息
       Query主要负责查询,例如:select *......
       Update主要负责修改数据库,同时该接口支持事务提交

您可以复制和转发本程序,禁止修改图标和属性信息

  1. (defun $URLencode$
  2.                    (str / code *SCR DATA)
  3.                                         ;($URLencode$  "http://192.168.0.107:8848/download?filename=中国.png")
  4.   (if STR
  5.     (if        (or
  6.           *SCR
  7.           (setq
  8.             *SCR (vlax-create-object
  9.                    "Aec32BitAppServer.AecScriptControl.1"
  10.                  )
  11.           )
  12.           (setq *SCR (vlax-create-object "ScriptControl"))
  13.         )
  14.       (progn
  15.         (vlax-put *SCR 'language "VBScript")
  16.         (setq code
  17.                "Function UTF8Encode(szString)
  18.         Dim szChar,szTemp,szCode
  19.         Dim szHex,szBin
  20.         Dim iCount1,iCount2
  21.         Dim iStrLen1,iStrLen2
  22.         Dim lResult
  23.         Dim lAscVal
  24.         exclude=\"-_.!~*'();/?:@&=+$,#\"
  25.         szString = Trim(szString)
  26.         iStrLen1 = Len(szString)
  27.         For iCount1 = 1 To iStrLen1
  28.             szChar = Mid(szString, iCount1, 1)
  29.             lAscVal = AscW(szChar)
  30.             If lAscVal >= &H0 And lAscVal <= &HFF Then
  31.                 If (lAscVal >= &H30 And lAscVal <= &H39) Or (lAscVal >= &H41 And lAscVal <= &H5A) Or (lAscVal >= &H61 And lAscVal <= &H7A) Or InStr(exclude,szChar) >0 Then
  32.                     szCode = szCode & szChar
  33.                 Else
  34.                     szCode = szCode & \"%\" & Hex(AscW(szChar))
  35.                 End If
  36.             Else
  37.                 szHex = Hex(AscW(szChar))
  38.                 iStrLen2 = Len(szHex)
  39.                 For iCount2 = 1 To iStrLen2
  40.                     szChar = Mid(szHex, iCount2, 1)
  41.                     szBin = szBin & Mid(\"0000;0001;0010;0011;0100;0101;0110;0111;1000;1001;1010;1011;1100;1101;1110;1111;\", CLng(\"&H\" & szChar) * 5 + 1, 4)
  42.                 Next
  43.                 szTemp = \"1110\" & Left(szBin, 4) & \"10\" & Mid(szBin, 5, 6) & \"10\" & Right(szBin, 6)
  44.                 For iCount2 = 1 To 24
  45.                     If Mid(szTemp, iCount2, 1) = \"1\" Then
  46.                         lResult = lResult + 1 * 2 ^ (24 - iCount2)
  47.                     Else
  48.                         lResult = lResult + 0 * 2 ^ (24 - iCount2)
  49.                     End If
  50.                 Next
  51.                 szTemp = Hex(lResult)
  52.                 szCode = szCode & \"%\" & Left(szTemp, 2) & \"%\" & Mid(szTemp, 3, 2) & \"%\" & Right(szTemp, 2)
  53.             End If
  54.             szBin = vbNullString
  55.             lResult = 0
  56.         Next
  57.         UTF8Encode = szCode
  58.     End Function"
  59.         )
  60.         (if (and
  61.               (not (vl-catch-all-error-p
  62.                      (vl-catch-all-apply
  63.                        'vlax-invoke
  64.                        (list *SCR
  65.                              'addcode
  66.                              code
  67.                        )
  68.                      )
  69.                    )
  70.               )
  71.               (not (vl-catch-all-error-p
  72.                      (setq str (vl-catch-all-apply
  73.                                  'vlax-invoke
  74.                                  (list *SCR
  75.                                        'run
  76.                                        "UTF8Encode"
  77.                                        str
  78.                                  )
  79.                                )
  80.                      )
  81.                    )
  82.               )
  83.             )
  84.           ()
  85.           (setq str nil)
  86.         )
  87.         (if *SCR
  88.           (vlax-release-object *SCR)
  89.         )
  90.       )
  91.       (progn (print "调用VBScript转码失败,组件未找到"))
  92.     )
  93.   )
  94.   str
  95. )
  96. (defun $带有报文头的POST/GET请求$ (host               header           header-vaule
  97.                                    content     GET&POST           array&str
  98.                                    /               $get-vaule$ $open$
  99.                                    $send$      jg           objhttp
  100.                                    return-value                   status
  101.                                    str
  102.                                   )        ;post方式请求,支持头文件定义
  103.                                         ;header 报文头
  104.                                         ;header-vaule 值
  105.                                         ;GET&POST POST方式请求?还是get方式请求?
  106.                                         ;array&str 返回数组格式还是字串格式?
  107.                                         ;content 请求子串

  108.   (defun $open$        (objHttp GET&POST host / return-value)
  109.     (IF        (vl-catch-all-error-p
  110.           (SETQ        return-value
  111.                  (vl-catch-all-apply
  112.                    'vla-open
  113.                    (list objHttp GET&POST host 0)
  114.                  )
  115.           )
  116.         )
  117.       (progn (print (vl-catch-all-error-message return-value))
  118.              nil
  119.       )
  120.       t
  121.     )
  122.   )
  123.   (defun $send$
  124.                 (objHttp header        header-vaule content / value err-str ERR
  125.                  seng-zt)
  126.     (DEFUN ERR ()
  127.       ()
  128.     )
  129.     (vl-catch-all-apply
  130.       'vlax-invoke-method
  131.       (list objHttp
  132.             "setRequestHeader"
  133.             (if        header
  134.               header
  135.               "Content-Length"
  136.             )
  137.             (if        header-vaule
  138.               header-vaule
  139.               ""
  140.             )
  141.       )
  142.     )
  143.     (vl-catch-all-apply
  144.       'vlax-invoke-method
  145.       (list objHttp
  146.             "setRequestHeader"
  147.             "Response-Charset"
  148.             "UTF8"
  149.       )
  150.     )
  151.     (vl-catch-all-apply
  152.       'vlax-invoke-method
  153.       (list objHttp
  154.             (if        header-vaule
  155.               header-vaule
  156.               "setRequestHeader"
  157.             )
  158.             "CONTENT-TYPE"
  159.             "text/plain"
  160.                                         ; text/xml、application/xml、text/plain、application/x-www-form-urlencoded
  161.       )
  162.     )
  163.     (SETQ value
  164.            (vl-catch-all-apply
  165.              'vlax-invoke-method
  166.              (list objHttp "send" content)
  167.            )
  168.     )
  169.     (if        (vl-catch-all-error-p value)
  170.       (progn (setq err-str (vl-catch-all-error-message value))
  171.              (print err-str)
  172.              (vlax-release-object objHttp) ;释放对象
  173.              (setq seng-zt nil)                ;如果在发送的过程中出现了意外就将zt做空
  174.       )
  175.       (setq seng-zt t)
  176.     )
  177.     seng-zt
  178.   )
  179.   (defun $get-vaule$ (objHttp         array&str  /               array-value
  180.                       chrs         jg            status     str
  181.                       tbl         value-body value-text txt
  182.                      )
  183.     (if
  184.       (and array&str (wcmatch array&str "[,sz,SZ,数组,]"))
  185.        (setq jg (vlax-get-property objHttp 'responsebody))
  186.        (progn
  187.          (and
  188.            (setq value-text
  189.                   (vlax-get-property objHttp 'responseText)
  190.            )
  191.                                         ;直接让系统ado组件返回text格式
  192.            (setq status t)
  193.            (setq jg value-text)
  194.          )
  195.        )
  196.     )
  197.     jg
  198.   )


  199.   (OR (AND GET&POST
  200.            (WCMATCH (STRCASE GET&POST) "[,GET,POST,]")
  201.            (SETQ GET&POST (STRCASE GET&POST))
  202.       )
  203.       (SETQ GET&POST "POST")
  204.   )
  205.   (IF (or (not header) (not header-vaule))
  206.     (SETQ header NIL
  207.           header-vaule
  208.            NIL
  209.     )                                        ;防止参数不对
  210.   )
  211.   (SETQ str "")
  212.   (IF (or (setq objHttp (vlax-create-object "Msxml2.ServerXMLHTTP")) ;
  213.           (setq objHttp (vlax-create-object "Msxml2.XMLHTTP"))
  214.       )
  215.     (PROGN
  216.       (setq return-value nil)
  217.       (setq host ($URLencode$ host))
  218.       (if ($open$ objHttp GET&POST host) ;开启
  219.         (PROGN
  220.           (if ($send$ objHttp header header-vaule content) ;发送
  221.             (PROGN
  222.               (while
  223.                 (not
  224.                   (eq (vlax-get-property objHttp "readyState") 4)
  225.                                         ;Response-Charset,readyState
  226.                 )
  227.                  (repeat 200)
  228.               )
  229.               (if (not (= (vlax-get-property objHttp "readyState") 4))
  230.                                         ;如果不等于4
  231.                 (vlax-release-object objHttp) ;释放对象
  232.               )
  233.               (if (= (vlax-get-property objHttp "readyState") 4)
  234.                 (IF (setq jg ($get-vaule$ objHttp array&str))
  235.                   (SETQ status T)
  236.                 )
  237.               )
  238.             )
  239.           )
  240.         )
  241.       )
  242.     )
  243.     (PROGN (ALERT
  244.              "操作系统安装有问题!\n\n无法创建对象\"Msxml2.XMLHTTP\""
  245.            )
  246.            (setq status nil)
  247.     )
  248.   )
  249.   (if objHttp
  250.     (vl-catch-all-error-p
  251.       (vl-catch-all-apply 'vlax-release-object (list objHttp))
  252.                                         ;防止没有释放对象 , 用出错跳过的方式解决
  253.     )
  254.   )
  255.   (if (not status)
  256.     (if        (and array&str (wcmatch array&str "[,sz,SZ,数组,]"))
  257.       ()
  258.       (progn
  259.         (setq jg
  260.                (strcat
  261.                  "(\"success\" . \"false\")"
  262.                  "(\"message\" . \"无法连接到远程数据库\")"
  263.                )
  264.         )
  265.       )
  266.     )
  267.   )
  268.   jg
  269. )


测试示例1:
  1. (setq str ($带有报文头的POST/GET请求$
  2.             (strcat "http://127.0.0.1:8000" "/" "Query")
  3.             "Client-Auth"
  4.             (getenv "ComputerName")  
  5.             "select * from 接线表 where `线号` is not null";返回接线表里面65535行数据
  6.             "POST"
  7.             nil
  8.           )
  9. )

  10. (progn
  11.   (setq data (vl-catch-all-apply 'read (list (strcat "(" str ")"))))
  12.   (if (vl-catch-all-error-p data)
  13.     (progn
  14.       (vl-catch-all-error-message data)
  15.       (setq data nil)
  16.       (if (> (strlen str) 5000)
  17.         (progn
  18.           (if (setq f
  19.                      (vl-filename-mktemp
  20.                        (strcat
  21.                          (vl-registry-read
  22.                            "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders"
  23.                            "Desktop"
  24.                          )
  25.                          "\\Error.txt"
  26.                        )
  27.                      )
  28.               )
  29.             (progn
  30.               (setq file (open f "w"))
  31.               (prin1 str file)
  32.               (close file)
  33.             )
  34.           )
  35.         )
  36.         (print str)
  37.       )
  38.     )
  39.   )
  40. )



测试示例2:
  1. (setq str ($带有报文头的POST/GET请求$
  2.             (strcat "http://127.0.0.1:8000" "/" "Query")
  3.             "Client-Auth"
  4.             (getenv "ComputerName")
  5.             "select * from 连接器 where `编码` = '174877-2'"
  6. ;;;            "select * from 连接器 where `编码` is not null"
  7.             "POST"
  8.             nil
  9.           )
  10. )

  11. (progn
  12.   (setq data (vl-catch-all-apply 'read (list (strcat "(" str ")"))))
  13.   (if (vl-catch-all-error-p data)
  14.     (progn
  15.       (vl-catch-all-error-message data)
  16.       (setq data nil)
  17.       (if (> (strlen str) 5000)
  18.         (progn
  19.           (if (setq f
  20.                      (vl-filename-mktemp
  21.                        (strcat
  22.                          (vl-registry-read
  23.                            "HKEY_CURRENT_USER\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders"
  24.                            "Desktop"
  25.                          )
  26.                          "\\Error.txt"
  27.                        )
  28.                      )
  29.               )
  30.             (progn
  31.               (setq file (open f "w"))
  32.               (prin1 str file)
  33.               (close file)
  34.             )
  35.           )
  36.         )
  37.         (print str)
  38.       )
  39.     )
  40.   )
  41. )




lisp调用go访问sqlite.part01.rar

3 MB, 下载次数: 13, 下载积分: D豆 -1 , 活跃度 1

lisp调用go访问sqlite.part02.rar

2.9 MB, 下载次数: 15, 下载积分: D豆 -1 , 活跃度 1

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

点击这里给我发消息

已领礼包: 30个

财富等级: 恭喜发财

发表于 2020-1-9 21:00:47 | 显示全部楼层
    这个厉害了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2020-1-9 21:15:26 | 显示全部楼层
(setq str ($带有报文头的POST/GET请求$
            (strcat "http://127.0.0.1:8000" "/" "Update")
            "Client-Auth"
            (getenv "ComputerName")  
            "update 连接器 set `规格` = '99k' where `编码` = '282079-2'";返回接线表里面65535行数据
            "POST"
            nil
          )
)

点评

(setq str ($带有报文头的POST/GET请求$ (strcat "http://127.0.0.1:8000" "/" "Update") "Client-Auth" (getenv "ComputerName") "Update 连接器 set `规格  详情 回复 发表于 2020-1-10 20:41
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3915个

财富等级: 富可敌国

发表于 2020-1-10 08:39:32 | 显示全部楼层
这个介绍好,可以学习如何将软件关联起来
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2020-1-10 20:41:26 | 显示全部楼层
dcl1214 发表于 2020-1-9 21:15
(setq str ($带有报文头的POST/GET请求$
            (strcat "http://127.0.0.1:8000" "/" "Update")
            "Cli ...

(setq str ($带有报文头的POST/GET请求$
            (strcat "http://127.0.0.1:8000" "/" "Update")
            "Client-Auth"
            (getenv "ComputerName")  
            "Update 连接器 set `规格` = '99k' where `编码` = '282079-2'";更新连接器表中规格
            "POST"
            nil
          )
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2020-1-10 20:45:18 | 显示全部楼层

test接口调用示例:
  1. (setq str ($带有报文头的POST/GET请求$
  2.             (strcat "http://127.0.0.1:8000" "/" "test")
  3.             "Client-Auth"
  4.             (getenv "ComputerName")
  5.             ""
  6.             "POST"
  7.             nil
  8.           )
  9. )
返回:
  1. (("dbtype" . "sqlite") ("Error" . "ok") ("状态" . "0") ("版本" . "V2.0") ("time" . "2020-01-10 20:42:19.495253 +0800") ("serverip" . "127.0.0.1") ("serverport" . "8000") ("hostname" . "HXT-20190521YVQ"))


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 7 天前 | 显示全部楼层
lisp调用go工具读取远程广域网数据库的标准件
通过GO连接数据库读取标准件.gif
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 5个

财富等级: 恭喜发财

发表于 7 天前 | 显示全部楼层
水平太低,看不明白呀
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2020-1-18 05:06 , Processed in 0.178468 second(s), 43 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表