[求助]：请教lisp编程中如何设置使用次数或时间的限值

xiaping

看见网上有些经过编译的VLX应用程序，设置了使用时间或使用次数的限值，程序使用了一定次数以后就不能继续使用了。很感兴趣，但是由于看不到源代码，无法了解这个功能实现的办法。那位朋友能不能给出实例。谢谢了。

zhynt

一个思路：读取系统时钟，然后跟预置值比较，如果相等就不加载，或显示警告框。
在使用次数上可以让程序在运行是生成一个使用次数记录文件，并且将该文件放的隐秘一点，以后每次运行程序都更新一次，当次数达到预置值就作相应的动作。

以上仅提供一个思路，想法可能比较简单。就作为抛砖引玉吧。

xiaping

谢谢斑竹。你提供的思路与我的猜想基本上一致。只是如果采用读取时钟的方式并不是很好，如果更改系统时间实际上限值就不起作用了。

mechal

也可以利用VLISP中有关注册表的操作，在注册表中添加键值，以达到控制的目的

hqd9639

利用系统时间的一种方法：

2. 
   
3. 
   
4. (setq hqdshare nil)
   
5. ;;----------------------------------------------------
   
6. (defun check_time (/  hqdregis  hqdshare time)
   
7.   (defun chrlist (s / c l)
   
8.     (setq c 0  l ())         
   
9.     (repeat (strlen s)
   
10.          (setq c (1+ c))
    
11.         (setq l (append l (list (substr s c 1))))
    
12.     )
    
13.   )
    
14.   ;--------------------------------------------------
    
15.   (defun unbeanit (s);;(s / bean c hex l r)
    
16.      (setq r "" c  -1 )
    
17.      (setq   hex  (chrlist "0123456789ABCDEF")
    
18.                bean  (chrlist "49382105")
    
19.                    l    (reverse (chrlist s))
    
20.     )
    
21.     (foreach chr l
    
22.               (setq c (1+ c))
    
23.              (setq r (strcat r (itoa (boole 6 (- 16 (length (member chr hex)))  (atoi (nth c bean))))))                     
    
24.     )
    
25.   )
    
26. ;;-------------------------------------------------------
    
27.   (defun beanit (s / bean c hex l r)
    
28.         (setq  r "" c  -1
    
29.              hex  (chrlist "0123456789ABCDEF")
    
30.             bean   (chrlist "49382105")
    
31.                   l   (chrlist s)
    
32.        )
    
33.       (foreach chr l
    
34.              (setq c (1+ c))
    
35.              (setq r (strcat r (nth (boole 6 (atoi chr) (atoi (nth c bean))) hex)))
    
36.       )
    
37.      (setq l (reverse (chrlist r))  r "")
    
38.          
    
39.     (foreach chr l (setq r (strcat r chr)))
    
40.   )
    
41. ;;-------------------------------------------------------  
    
42.    (setq t1 (beanit (itoa (fix (getvar "date")))))
    
43.    (if (not (setq dat1 (getcfg "AppData/MyCAD/Usertime")))
    
44.        (setq dat1 (setcfg "AppData/MyCAD/Usertime" t1))
    
45.     )            
    
46.      (if  (and (> (setq time (- 30 (- (fix (getvar "date")) (atoi  (unbeanit dat1))))) 0) (< time 31))
    
47.            (setq hqdshare (strcat   "\n这是试用版，你还有： "  (itoa time) " 天使用期\n"))
    
48.           (setq hqdshare nil)
    
49.       )
    
50. 
    
51.    (if  hqdshare
    
52.         (progn
    
53.                (hqdprmload)
    
54.                (alert hqdshare)
    
55.          )
    
56.       (progn
    
57.                  (alert  "\n程序试用期满，如你还需继续使用，请进行注册\n")
    
58.                 (defun hqdprmload ()
    
59.                           (princ "\n程序试用期满...")
    
60.                           (princ "\n")
    
61.               )
    
62.     )
    
63. )
    
64. )
    
65. 
    
66. ;;---------------------------------------
    
67. (defun hqdprmload ()
    
68.      (defun c:ld ( )     
    
69.            (setq A1 (getvar "LOGINNAME"))
    
70.            (if  (/= A1 "hqd9639")
    
71.                 (alert "非经同意不得使用AUTOCAD")
    
72.                (alert "欢迎您使使用我的AUTOCAD")
    
73.           )
    
74.          ( princ)
    
75.     )
    
76.    (princ)
    
77. )
    
78. ;;;-----------------------------
    
79. (check_time)
    
80. (princ)
    
81. ;;------------------------------

<br /> <br /> (setq hqdshare nil)<br /> ;;----------------------------------------------------<br /> (defun check_time (/  hqdregis  hqdshare time) <br />   (defun chrlist (s / c l) <br />     (setq c 0  l ())         <br />     (repeat (strlen s) <br />          (setq c (1+ c))<br />         (setq l (append l (list (substr s c 1))))<br />     )<br />   ) <br />   ;--------------------------------------------------<br />   (defun unbeanit (s);;(s / bean c hex l r) <br />      (setq r "" c  -1 )<br />      (setq   hex  (chrlist "0123456789ABCDEF") <br />                bean  (chrlist "49382105")<br />                    l    (reverse (chrlist s))<br />     )<br />     (foreach chr l<br />               (setq c (1+ c))<br />              (setq r (strcat r (itoa (boole 6 (- 16 (length (member chr hex)))  (atoi (nth c bean))))))                     <br />     )<br />   ) <br /> ;;-------------------------------------------------------<br />   (defun beanit (s / bean c hex l r) <br />         (setq  r "" c  -1<br />              hex  (chrlist "0123456789ABCDEF")<br />             bean   (chrlist "49382105")<br />                   l   (chrlist s)<br />        )<br />       (foreach chr l <br />              (setq c (1+ c))<br />              (setq r (strcat r (nth (boole 6 (atoi chr) (atoi (nth c bean))) hex)))<br />       ) <br />      (setq l (reverse (chrlist r))  r "")<br />           <br />     (foreach chr l (setq r (strcat r chr)))<br />   ) <br /> ;;-------------------------------------------------------  <br />    (setq t1 (beanit (itoa (fix (getvar "date")))))<br />    (if (not (setq dat1 (getcfg "AppData/MyCAD/Usertime"))) <br />        (setq dat1 (setcfg "AppData/MyCAD/Usertime" t1))<br />     )            <br />      (if  (and (> (setq time (- 30 (- (fix (getvar "date")) (atoi  (unbeanit dat1))))) 0) (< time 31))<br />            (setq hqdshare (strcat   "\n这是试用版，你还有： "  (itoa time) " 天使用期\n"))<br />           (setq hqdshare nil)<br />       )<br /> <br />    (if  hqdshare <br />         (progn<br />                (hqdprmload) <br />                (alert hqdshare)<br />          )<br />       (progn<br />                  (alert  "\n程序试用期满，如你还需继续使用，请进行注册\n") <br />                 (defun hqdprmload () <br />                           (princ "\n程序试用期满...") <br />                           (princ "\n")<br />               ) <br />     )<br /> )<br /> ) <br /> <br /> ;;---------------------------------------<br /> (defun hqdprmload () <br />      (defun c:ld ( )     <br />            (setq A1 (getvar "LOGINNAME")) <br />            (if  (/= A1 "hqd9639") <br />                 (alert "非经同意不得使用AUTOCAD") <br />                (alert "欢迎您使使用我的AUTOCAD")<br />           ) <br />          ( princ)<br />     )<br />    (princ)<br /> ) <br /> ;;;-----------------------------<br /> (check_time) <br /> (princ) <br /> ;;------------------------------

前生

刀法是死的,人是活的!

LUCAS

;;一种典型LISP时间限制(像GEARFACTORYD),它只用"SETCFG"把<规划值>
;;资料写入ACAD*.CFG 档案中的"应用程序区段"(AppData区段)
;;如下:
;;[AppData/GearFactory]
;;RegCode=951A6D6
;;只要把它删除,时间限制就失效了。

xyz

(DEFUN TIMER (/ l68|l l68%l l68?& l68j& l68@&)
  (IF (SETQ l68|l (FINDFILE "l *.dcl"))
    (PROGN
      (SETQ l68%l (OPEN l68|l "r")
            l68?& ""
      )
      (WHILE (SETQ l68@& (READ-LINE l68%l)) (SETQ l68j& l68@&))
      (IF (= (SUBSTR l68j& 1 2) "//")
        (PROGN
          (SETQ        l68j& (SUBSTR l68j& 3 7)
                l68Q& 1
          )
          (REPEAT 7
            (SETQ l68?&        (STRCAT        l68?&
                                (ITOA (- (ASCII (SUBSTR l68j& l68Q& 1)) 100))
                        )
                  l68Q&        (1+ l68Q&)
            )
          )
          (IF (>= (- (FIX (GETVAR "date")) (ATOI l68?&)) 30)
            (PROGN
              (PROMPT
                "\n30 day trial period is up.\nPlease see README file for ordering information."
              )
              (l68Ol)
              (CLOSE l68%l)
            )
            (IF        (<= (- 30 (- (FIX (GETVAR "date")) (ATOI l68?&))) 30)
              (PROGN
                (PROMPT "\n")
                (PRINC (- 30 (- (FIX (GETVAR "date")) (ATOI l68?&))))
                (PROMPT " days left of 30 day trial.")
                (CLOSE l68%l)
              )
              (PROGN (l68Ol) (CLOSE l68%l))
            )
          )
        )
        (PROGN (CLOSE l68%l)
               (SETQ l68%l (OPEN l68|l "a"))
               (SETQ l68j& (ITOA (FIX (GETVAR "date")))
                     l68Q& 1
               )
               (WRITE-CHAR 47 l68%l)
               (WRITE-CHAR 47 l68%l)
               (REPEAT (STRLEN l68j&)
                 (WRITE-CHAR (+ 100 (ATOI (SUBSTR l68j& l68Q& 1))) l68%l)
                 (SETQ l68Q& (1+ l68Q&))
               )
               (PROMPT "\nThis is a 30 day trial.")
               (CLOSE l68%l)
        )
      )
    )
    (PROGN
      (PROMPT
        "\nCannot find LAYER.DCL.\nCheck to make sure it's in the ACAD path."
      )
      (l68Ol)
      (EXIT)
    )
  )
  (PRINC)
)
(>= (SETQ l68O (LOAD_DIALOG "layer.dcl")) 0)
(NEW_DIALOG "layview" l68O)
(SET_TILE "title" " ** 30 Day Trial ** ")
(START_LIST "list_box")
(MAPCAR        (quote ADD_LIST)
        (LIST
          "Try then buy software."
          ""
          "SEND 25 人民币 "
          ""
          "\t xyz"
          "\tchina"
          "\tzz"
          ""
          ""
          "Include your Return Address plus disk format (5?or 3?"
          "or send Internet or Compuserve e-mail"
          "address for faster response."
         )
)
(END_LIST)
(START_DIALOG)
(UNLOAD_DIALOG l68O)
(PROMPT "\n\t** Type LC for Layer Utility Commands **")
(TIMER)
(PRINC)

xiaping

谢谢各位的热心指教。

wei209

谢谢8楼的!

TLHMQH

把这么老的帖子捞上来，顶一下。

jx2008

该主题的帖子很好！

animal212

我还是对写入注册表的比较感兴趣，但是不知道怎么写入和读出，请楼下的举个例子说明下，谢谢。

kongel

学习中

何足言

读写注册表示例

_$ (vl-registry-write "HKEY_CURRENT_USER\\Test" "" "test data")
"test data"
_$ (vl-registry-read "HKEY_CURRENT_USER\\Test")
"test data"