分享一个加密程序锁定硬盘。

yangjian001

谢谢楼主分享

75215195

1. (defun UseLimit (/ FIND_SERIALNUMBER regNumber num regnum reg_path)
   
2.   (vl-load-com);*****获取网络时间******
   
3. (defun get-time (/ xpost var)
   
4.     (if (SetQ xPost (vlax-get-or-create-object "Microsoft.XMLHTTP"))
   
5.         (progn
   
6.             ;;同步打开连接
   
7.             (vlax-invoke-method
   
8.                 XPOST                    'OPEN
   
9.                 "Put"                    " Http://time.nist.gov:13"
   
10.                 :vlax-false
    
11.                )
    
12.             ;;发送请求
    
13.             (vlax-invoke-method XPOST 'Send)
    
14.             ;;判断状态
    
15.             (while (/= (vlax-get-property xpost 'readyState) 4))
    
16.             ;;取出结果
    
17.             (while
    
18.                 (not (setq var (vlax-get-property xpost 'responsetext)))
    
19.             )
    
20.             ;;释放资源
    
21.             (vlax-release-object xPost)
    
22.             ;;返回
    
23.             var
    
24.         )
    
25.     )
    
26. )
    
27. ;*****时间限制**************  
    
28. (defun limitime (/ time)
    
29.     ;本地时间 取消该项避免修改本地时间跳过时间限制(setq time (atoi (rtos (getvar "cdate"))))
    
30.     (setq time1 (substr (GET-TIME) 8 8)) ;网络时间
    
31.     (setq nettime (atoi (strcat "20" (substr time1 1 2) (substr time1 4 2) (substr time1 7 7))))
    
32.     (if (< nettime 20180801) T nil) ;设置试用时间
    
33.     )
    
34. ;*****获取硬盘序列号**********
    
35.   (defun FIND_SERIALNUMBER (DRIVE / FILSYS VAL)
    
36.     (setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))
    
37.     (setq VAL (vlax-invoke FILSYS "GetDrive" DRIVE))
    
38.     (setq VAL (vl-catch-all-apply
    
39.                 'vlax-get
    
40.                 (list VAL "SerialNumber")
    
41.               )
    
42.     )
    
43.     (vlax-release-object FILSYS)
    
44.     (if        (vl-catch-all-error-p VAL)
    
45.       (setq VAL NIL)
    
46.       VAL
    
47.     )
    
48.   )
    
49. ;*****注册程序****************
    
50.   (if (not (limitime))
    
51.     (progn
    
52.   (setq reg_path "HKEY_CURRENT_USER\\Software\\KenFiles\\temp")
    
53.   (setq regNumber (vl-registry-read reg_path "注册码"))
    
54.   (if (/= regNumber
    
55.          (itoa
    
56.               (+ (/ (FIND_SERIALNUMBER "C:") 2) 1234567);;;注册码=申请码/2+1234567
    
57.          )
    
58.       )
    
59.     (progn
    
60.       (setq num (itoa (FIND_SERIALNUMBER "C:")))
    
61.       (setq regnum (itoa (+ (/ (atoi num) 2) 1234567)));;;注册码=申请码/2+1234567
    
62.       (princ
    
63.         (strcat "您的申请码为: " num)
    
64.       )
    
65.       (setq regNumber (getstring "\n请输入注册码:"))
    
66.       (if (/= regNumber regnum)
    
67.         (progn
    
68.           (alert "注册码无效!")
    
69.           (princ"\n退出程序!")
    
70.         )
    
71.         (progn
    
72.           (vl-registry-write reg_path "注册码" regnum)
    
73.           (alert "您已成功注册!")
    
74.         )
    
75.       )
    
76.       T
    
77.     )
    
78.     nil
    
79.   )
    
80.   )
    
81.     nil
    
82.     )
    
83. )
    
84. ;*************************************
    
85. (defun c:XX()
    
86.   (if (not (UseLimit))
    
87.     (progn
    
88.   ;..........主程序.........
    
89.   )
    
90.     )
    
91.   (princ)
    
92.   )
    

(defun UseLimit (/ FIND_SERIALNUMBER regNumber num regnum reg_path)<br />   (vl-load-com);*****获取网络时间******<br /> (defun get-time (/ xpost var)<br />     (if (SetQ xPost (vlax-get-or-create-object "Microsoft.XMLHTTP"))<br />         (progn<br />             ;;同步打开连接<br />             (vlax-invoke-method<br />                 XPOST                    'OPEN<br />                 "Put"                    " <a href=\"Http://time.nist.gov:13\" target=\"_blank\">Http://time.nist.gov:13</a>"<br />                 :vlax-false<br />                )<br />             ;;发送请求<br />             (vlax-invoke-method XPOST 'Send)<br />             ;;判断状态<br />             (while (/= (vlax-get-property xpost 'readyState) 4))<br />             ;;取出结果<br />             (while<br />                 (not (setq var (vlax-get-property xpost 'responsetext)))<br />             )<br />             ;;释放资源<br />             (vlax-release-object xPost)<br />             ;;返回<br />             var<br />         )<br />     )<br /> )<br /> ;*****时间限制**************  <br /> (defun limitime (/ time)<br />     ;本地时间 取消该项避免修改本地时间跳过时间限制(setq time (atoi (rtos (getvar "cdate"))))<br />     (setq time1 (substr (GET-TIME) 8 8)) ;网络时间<br />     (setq nettime (atoi (strcat "20" (substr time1 1 2) (substr time1 4 2) (substr time1 7 7))))<br />     (if (< nettime 20180801) T nil) ;设置试用时间<br />     )<br /> ;*****获取硬盘序列号**********<br />   (defun FIND_SERIALNUMBER (DRIVE / FILSYS VAL)<br />     (setq FILSYS (vlax-create-object "Scripting.FileSystemObject"))<br />     (setq VAL (vlax-invoke FILSYS "GetDrive" DRIVE))<br />     (setq VAL (vl-catch-all-apply<br />                 'vlax-get<br />                 (list VAL "SerialNumber")<br />               )<br />     )<br />     (vlax-release-object FILSYS)<br />     (if        (vl-catch-all-error-p VAL)<br />       (setq VAL NIL)<br />       VAL<br />     )<br />   )<br /> ;*****注册程序****************<br />   (if (not (limitime))<br />     (progn<br />   (setq reg_path "HKEY_CURRENT_USER\\Software\\KenFiles\\temp")<br />   (setq regNumber (vl-registry-read reg_path "注册码"))<br />   (if (/= regNumber<br />          (itoa<br />               (+ (/ (FIND_SERIALNUMBER "C:") 2) 1234567);;;注册码=申请码/2+1234567<br />          )<br />       )<br />     (progn<br />       (setq num (itoa (FIND_SERIALNUMBER "C:")))<br />       (setq regnum (itoa (+ (/ (atoi num) 2) 1234567)));;;注册码=申请码/2+1234567<br />       (princ<br />         (strcat "您的申请码为: " num)<br />       )<br />       (setq regNumber (getstring "\n请输入注册码:"))<br />       (if (/= regNumber regnum)<br />         (progn<br />           (alert "注册码无效!")<br />           (princ"\n退出程序!")<br />         )<br />         (progn<br />           (vl-registry-write reg_path "注册码" regnum)<br />           (alert "您已成功注册!")<br />         )<br />       )<br />       T<br />     )<br />     nil<br />   )<br />   )<br />     nil<br />     )<br /> )<br /> ;*************************************<br /> (defun c:XX()<br />   (if (not (UseLimit))<br />     (progn<br />   ;..........主程序.........<br />   )<br />     )<br />   (princ)<br />   )<br />

2018-08-10更新本地时间改为网络时间

kqqt6236

谢谢分享。