借助数据库产生随机数

dcl1214

1. (defun $round$ (n-min n-max ws / rnds sjs sql strs sjs)
   
2. ;n-min 最小值
   
3. ;n-max 最大值
   
4. ;ws 小数位数
   
5.   (setq n-min (vl-catch-all-apply 'vl-princ-to-string (list n-min)))
   
6.   (setq n-max (vl-catch-all-apply 'vl-princ-to-string (list n-max)))
   
7.   (setq ws (vl-catch-all-apply 'vl-princ-to-string (list ws)))
   
8.   (if (vl-catch-all-error-p n-min)
   
9.     (setq n-min nil)
   
10.   )
    
11.   (if (vl-catch-all-error-p n-max)
    
12.     (setq n-max nil)
    
13.   )
    
14.   (if (vl-catch-all-error-p ws)
    
15.     (setq ws "1")
    
16.   )
    
17.   (if (and n-min n-max (> n-max n-min))
    
18.     (progn
    
19.       (setq rnds (mapcar (function
    
20.          (lambda (a)
    
21.            (strcat
    
22.              (strcat "ROUND("
    
23.                n-min
    
24.                " + RAND() * ("
    
25.                n-max
    
26.                " - "
    
27.                n-min
    
28.                "), "ws") AS rand"
    
29.                (itoa a)
    
30.              )
    
31.            )
    
32.          )
    
33.        )
    
34.        (list 1 2 3 4 5)
    
35.      )
    
36.       )
    
37.       (setq strs (mapcar (function (lambda (a) (strcat a ",")))
    
38.        (reverse (cdr (reverse rnds)))
    
39.      )
    
40.       )
    
41.       (setq strs (append strs (list (last rnds))))
    
42.       (setq sql
    
43.        (apply 'strcat strs)
    
44.       )
    
45.       (setq sql (strcat "select " sql))
    
46.       (setq sjs
    
47.        (car
    
48.          ($http-server$
    
49.      (list
    
50.        (cons "IP" (getenv "数据库地址"))
    
51.        (cons "端口" ($locport$))
    
52.        (cons "接口" ($fu-wu-qi-jie-kou$ "查询表"))
    
53.           ;(cons "数据库路径" "C:\\ZXCAD.DB")
    
54.        (cons
    
55.          "报文头"
    
56.          (list (cons "Client-Auth" (getenv "ComputerName")))
    
57.        )
    
58.        (cons "Sql" SQL)
    
59.        (cons "http方法" "POST")
    
60.        (cons "返回格式" "db")
    
61.      )
    
62.          )
    
63.        )
    
64.       )
    
65.       (setq sjs(mapcar 'cdr sjs))
    
66.     )
    
67.   )
    
68.   sjs
    
69. )

(defun $round$ (n-min n-max ws / rnds sjs sql strs sjs)<br /> ;n-min 最小值<br /> ;n-max 最大值<br /> ;ws 小数位数<br />   (setq n-min (vl-catch-all-apply 'vl-princ-to-string (list n-min)))<br />   (setq n-max (vl-catch-all-apply 'vl-princ-to-string (list n-max)))<br />   (setq ws (vl-catch-all-apply 'vl-princ-to-string (list ws)))<br />   (if (vl-catch-all-error-p n-min)<br />     (setq n-min nil)<br />   )<br />   (if (vl-catch-all-error-p n-max)<br />     (setq n-max nil)<br />   )<br />   (if (vl-catch-all-error-p ws)<br />     (setq ws "1")<br />   )<br />   (if (and n-min n-max (> n-max n-min))<br />     (progn<br />       (setq rnds (mapcar (function<br />          (lambda (a)<br />            (strcat<br />              (strcat "ROUND("<br />                n-min<br />                " + RAND() * ("<br />                n-max<br />                " - "<br />                n-min<br />                "), "ws") AS rand"<br />                (itoa a)<br />              )<br />            )<br />          )<br />        )<br />        (list 1 2 3 4 5)<br />      )<br />       )<br />       (setq strs (mapcar (function (lambda (a) (strcat a ",")))<br />        (reverse (cdr (reverse rnds)))<br />      )<br />       )<br />       (setq strs (append strs (list (last rnds))))<br />       (setq sql<br />        (apply 'strcat strs)<br />       )<br />       (setq sql (strcat "select " sql))<br />       (setq sjs<br />        (car<br />          ($http-server$<br />      (list<br />        (cons "IP" (getenv "数据库地址"))<br />        (cons "端口" ($locport$))<br />        (cons "接口" ($fu-wu-qi-jie-kou$ "查询表"))<br />           ;(cons "数据库路径" "C:\\ZXCAD.DB")<br />        (cons<br />          "报文头"<br />          (list (cons "Client-Auth" (getenv "ComputerName")))<br />        )<br />        (cons "Sql" SQL)<br />        (cons "http方法" "POST")<br />        (cons "返回格式" "db")<br />      )<br />          )<br />        )<br />       )<br />       (setq sjs(mapcar 'cdr sjs))<br />     )<br />   )<br />   sjs<br /> )

我爱lisp

很好，可以配个案例。; 错误: no function definition: $LOCPORT$

kozmosovia

拉出意大利炮打蚊子

dcl1214

我爱lisp 发表于 2024-4-1 16:36
很好，可以配个案例。; 错误: no function definition: $LOCPORT$

加载dbo.vlx即可

伊江痕

学到了  很有用