自动打包、编译、备份、加密lisp源码

admin1

本帖最后由 MUSIC-DIE 于 2022-9-21 12:28 编辑


在lisp开发过程中有以下痛点：
1、管理lisp源码的过程中，如果使用vlide编译，每个lisp源码都会单独编译出一个fas文件，而我们需要的只是一个fas文件包含所有功能
2、多个lisp源码文件，有利于我们单独管理每个功能，不至于一个文件报错，所有功能停摆
3、GIT版本管理很方便，学习却有门槛
4、源码被随便反编译

附件在尽可能简单的基础上解决了这部分问题：
1、附件中命令运行后，会将指定文件夹下的文件合并为一个lisp源码文件
2、将此源码文件备份起来，以备错误操作后，可以查看以前的正确源代码
3、备份后自动调用Vlide进行编译，并输出到指定的文件夹
4、集成了海大师（tryhi）的可变长参数功能，如果在代码中指定了可变长的函数，将自动对其进行处理，可在一定程度上加密你的代码

;;将定义了可选参数的fas文件进行处理  作者_tryhi-大海
(defun c:fas2b (/ bb file newfas)
        (setq file (getfiled "选择fas或vlx文件:" "" "fas;vlx" 0))
        (or file (try-exit))
        (setq bb (try-file-ReadBinary file));将文件转为十六进制字符串
        (setq newfas (fas_goto (fas2kexuan bb)))
        (vl-file-delete file)
        (try-file-WriteBinary file newfas)
        (princ "\n编译完成！")(princ)       
)

(defun c:WMCMP (/ bb fil_pat file file:dir:s line MFC newfas NN op PATH)
        (if (= (strcase (getvar "loginname")) "loginname")                        ;判断是家里的电脑还是公司的电脑
                (setq PATH "D:\\坚果同步\\ACADplugin")                                                                ;打包完成的文件存放位置
                (setq PATH "C:\\Users\\yx\\Nutstore\\1\\ACADplugin")
        )
        (setq MFC (open (strcat PATH "\\备份\\MFC-" (rtos (fix (getvar "CDATE")) 2 0) ".lsp") "w"))        ;合并的目标文件，备份文件
        (setq file:dir:s (VL-DIRECTORY-FILES (strcat PATH "\\仓库\\mfclisp\\src") "*.lsp" 1))                         ;源文件和打包完成文件的存放地址关系
        (foreach nn file:dir:s
                (setq fil_pat (strcat PATH "\\仓库\\mfclisp\\src\\" nn))
                (setq op (open fil_pat "r"))
                (while (setq line (read-line op))
                        (write-line line MFC)
                )
                (close op)        ;;关闭文件
        )
        (close MFC)
        (if (= nil vlisp-compile) (c:vlide))
        (CKQZ (vla-get-Name (*DOC*)))
        (vlisp-compile 'st         (strcat PATH "\\备份\\MFC-" (rtos (fix (getvar "CDATE")) 2 0 ) ".lsp")
                                                (setq file (strcat PATH "\\MFC.fas"))
        )
        (or file (try-exit))
        (setq bb (try-file-ReadBinary file));将文件转为十六进制字符串
        (setq newfas (fas2kexuan bb))
        (vl-file-delete file)
        (try-file-WriteBinary file newfas)
        (princ "\n编译完成！")
        (princ)       
)

;;将带有可选参数标志的fas进行转换，返回FAS十六进制字符串，同时删除首句
;;加密标识为(setq xx 1122334455 xx 1 xx 0);xx为任意变量名称
(defun fas2kexuan (str / 14weizhi a1 a4 fd leng n ret tou w xx xxxx zuidi zuiduo)
        (setq
                fd(try-StrRegExp str ".+?33F776E54206....32........32..06....|.+$" );按照标志拆分两个32后面两个字符为短整型申明，用于确定最少、最多参数申明
                ret ""
        )

        (while(setq n(car fd)fd(cdr fd));循环除了最后一个之外
                (setq
                        leng(strlen n);单个片段总长度，即n变量字符串
                        14weizhi(read1401010100 n);函数入口位置
                        w(substr n 14weizhi);1401010100xxxx……33F776E54206....32........32..06....
                        tou(substr n 1 (1- 14weizhi))
                        xxxx(substr w 11(-(strlen w)(+ 22 24)));1401010100之后第一个字符到33F776E54206之间
                        zuidi(substr w (-(strlen w)17)2);最低参数数量
                        zuiduo(substr w (-(strlen w)7)2);最多参数数量
                )
                (setq a1 (substr w 3 2));14后第一个值
                (if (= zuiduo "00");用于判断是否采用无限
                        (setq a4 "01";无限
                                zuiduo (10>>16(1-(16>>10 a1)))
                        )
                        (setq a4 "00");有限
                )
                (setq
                        xx(strcat "14" a1 zuidi zuiduo a4 xxxx "570D00000001010101010101010101010101");
                )
                (setq ret (strcat ret tou xx))
        )
        (setq ret (strcat ret n))
)







;;;======================================
;;;===========以下为内裤部分=============
;;;======================================

(defun 10>>16 (n / n16)
        (setq a(rem n 16)
                b(/ n 16)
        )
        (setq n16 '("0" "1" "2" "3"
                                                         "4" "5" "6" "7"
                                                         "8" "9" "A" "B"
                                                         "C" "D" "E" "F"))
        (strcat(nth b n16)(nth a n16))
)
(defun 16>>10 (n / n16)
        (setq n16 '("0" "1" "2" "3"
                                                         "4" "5" "6" "7"
                                                         "8" "9" "A" "B"
                                                         "C" "D" "E" "F"))
        (setq
                n(strcase n)
                a(substr n 1 1)
                b(substr n 2 1)
        )
        (+(* 16(vl-position a n16))(vl-position b n16))
)
(defun try-desktop(/ a ws)
        (SetQ ws (vlax-get-or-create-object "Wscript.Shell"))
        (setq a (vlax-invoke (vlax-get-property ws
                                                                                                 'SpecialFolders) 'item "Desktop"))
        (vlax-release-object ws)
        a)

(defun read1401010100 (str / k k5 lst ns)
        (setq ns(str16->lst10 str));十六进制字符串转整数表
        (setq lst ns k t)
        (while (and k(setq k5(try-lst-read-last lst 5)));截取最后5个
                (setq lst(reverse(cdr(reverse lst))));删除最后一个
                (mapcar 'set '(a1 a2 a3 a4 a5) k5)
                (if
                        (and
                                (= a1 20)
                                (>= a2 a3)
                                (= a3 a4)
                                (= a5 0)
                        )
                        (setq k nil)
                )
        )
        (-(* 2(length lst))7)
)
(defun try-lst-read-last(lst i / a ls lstt ret)
        (if (> i 0)
                (if(<=(length lst)i) lst
                        (progn
                                (setq ls(reverse lst))
                                (repeat i
                                        (setq ret(cons (car ls)ret)
                                                ls(cdr ls)
                                        )
                                )
                                ret
                        )
                )
        )
)


(defun str16->lst10 (str16)
        (mapcar 'try-16-to-10 (mapcar '(lambda (x) (strcat (car x) (cadr x))) (try-lst-div (try-StringSplit str16 "") 2)))
)
(defun try-16-to-10 (n / 16-10 f i ii j m)
        (setq n (strcase n))
        (setq i 0 j (strlen n)m 0
                16-10 '(("0"0)("1"1)("2"2)("3"3)("4"4)("5"5)("6"6)("7"7)("8"8)("9"9)("A"10)("B"11)("C"12)("D"13)("E"14)("F"15))
        )
        (repeat j
                (setq
                        f(substr n j 1)
                        ii(cadr(assoc f 16-10))
                        m(+ m (* (expt 16 i) ii))
                        i(1+ i)
                        j(1- j)
                )
        )
        m
)
(defun try-lst-div (lst nn / lst2)
        (foreach n lst
                (if (and lst2 (/= nn (length (car lst2))))
                        (setq lst2 (cons (append (car lst2) (list n)) (cdr lst2)))
                        (setq lst2 (cons (list n) lst2))
                )
        )
        (reverse lst2)
)
(defun try-StringSplit(str char / a b i )
        (if (= "" char)(_Str2List str)
                (progn
                        (while (setq i(vl-string-search char str))
                                (setq a(substr str 1 i)
                                        b(cons a b)
                                        str(substr str (+ i (strlen char)1)))
                        )
                        (reverse(cons str b))
                )
        )
)
(defun _Str2List(str / a);作者：LLSheng_73
        (setq str(vl-string->list str))
        (while
                (if(<(car str)129)
                        (setq a(cons(chr(car str))a)str(cdr str))
                        (setq a(cons(strcat(chr(car str))(chr(cadr str)))a)str(cddr str))))
        (reverse a)
)


;;fas修改gogo标志
;;参数为fas完整十六进制字符串
;;起跳标志33C076E54206....32..06....
;;终点标志33C176E54206....32..06....
(defun fas_goto(str / end-i num num16 strats strats-i)
        (setq
                strats(try-StrRegExp str "33C076E54206....32..06...." );获取所有起跳标志
        )
        (foreach n strats
                (setq
                        strats-i(gt-str-s str n);起点索引
                        end-i(gt-str-s str (strcat"33C176E54206....32"(substr n 19 2)"06...."));终点索引
                        num(-(/(- end-i strats-i)2)5);起点离终点的距离
                        num16(if (< num 0)(fas32-int num)(fas32int num))
                )
                (setq        str(strcat;修改起跳标志
                                                         (substr        str        1 (1- strats-i))
                                                         "57"num16"0000000000000000"
                                                         (substr        str         (+ 26 strats-i))
                                                 )
                       
                )
        )
        (setq str(try-StrRegExpReplace str "33C176E54206....32..06...." "57080000000000000000000000"));屏蔽掉所有终点标志
        str
)


;;搜索指定十六进制字符串的起点索引（1基）
;;通配符.
(defun gt-str-s (str st / a)
        (setq a(car(try-StrRegExp str (strcat st".*$"))))
        (if a
                (-(strlen str)(strlen a)-1)
        )
)


;将一个负值转为fas文件用的32位整数
;该算法最小支持到-268435456，即256MB（超过返回错误结果）
(defun fas32-int (n / a b)
        (if (< n -268435456)(princ "\n负值超限"))
        ?(setq a(+ 2147483647 n 1);7FFFFFFF为整数最大值
                 b(try-10-to-16 a)
         )
        (strcat(substr b 7 2)(substr b 5 2)(substr b 3 2)"F"(substr b 2 1))
)

;;将一个非负值转为fas文件用的32位整数
(defun fas32int (n)
        (if (> n 2147483647)(princ "\n非32位正整数"))
        (setq a(try-10-to-16 n)
                b(try-str-bu0 a 8 )
        )
        (strcat(substr b 7 2)(substr b 5 2)(substr b 3 2)(substr b 1 2))
)







;;;======================================
;;;===========以下为内裤部分=============
;;;======================================
(defun try-StrRegExp(str1 expr)
        (_Replace str1 expr nil "")
)
(defun try-StrRegExpReplace(str1 expr str2)
        (_Replace str1 expr T str2)
)
(defun try-10-to-16(n / 10-16 m n16x x)
        (setq x "" 10-16 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"))
        (while (/= 0 n)
                (setq
                        m(rem n 16)
                        n(/ n 16)
                        n16x(nth m 10-16)
                        x(strcat n16x x)
                )
        )
        (if (= x "")"0"x)
)
(defun try-str-bu0 (str n0 / _000)
        (setq _000 "")
        (repeat(- n0 (strlen str ))(setq _000(strcat "0" _000)))
        (strcat _000 str)
)

(defun try-exit ()(VL-EXIT-WITH-VALUE 0))
(defun try-file-ReadBinary (FileName / node size str stream xmldom)
        (setq xmldom (vlax-create-object "Microsoft.XMLDOM"))
        (setq node (vlax-invoke-method xmldom 'CreateElement "binary"))
        (vlax-put-Property node 'DataType "bin.hex")
        (setq stream (vlax-create-object "ADODB.Stream"))
        (vlax-put-Property stream 'type 1)
        (Vlax-Invoke stream 'open)
        (vlax-invoke-method
                stream
                'LoadFromFile
                FileName
        )
        (setq size(vlax-get-Property stream 'size))
        (vlax-put-Property node 'NodeTypedValue (Vlax-Invoke-Method stream 'Read size))
        (Vlax-Invoke-Method stream 'close)
        (setq str (vlax-get-Property node 'text))
        (vlax-release-object xmldom)
        str
)
(defun try-file-WriteBinary (file str / node stream xmldom)
        (setq xmldom (vlax-create-object "Microsoft.XMLDOM"))
        (setq node (vlax-invoke-method xmldom 'CreateElement "binary"))
        (vlax-put-Property node 'DataType "bin.hex")
        (vlax-put-Property node 'Text str)
        (setq stream (vlax-create-object "ADODB.Stream"))
        (vlax-put-Property stream 'type 1)
        (Vlax-Invoke stream 'open)
        (vlax-invoke-method stream 'write
                (vlax-get-Property node 'NodeTypedValue)
        )
        (vlax-invoke-method stream 'saveToFile file 2)
        (Vlax-Invoke-Method stream 'close)
        (vlax-release-object xmldom)
        (vlax-release-object stream)
)
(defun _Replace(str1 str2 bull str3 / lst matchcollect reg)
        (setq lst '())
        (setq reg (vlax-create-object "vbscript.regexp")) ;创建正则表达式
        (if (null reg)
                (progn
                        (alert "发现系统vbscript没有注册，现尝试对其注册")
                        (command"shell" "copy %systemroot%\\System32\\vbscript.dll %systemroot%\\System\\")
                        ;(command"shell" "copy C:\\Windows\\System32\\vbscript.dll C:\\Windows\\")
                        (command"shell" "regsvr32 vbscript.dll")
                        (setq reg (vlax-create-object "vbscript.regexp"))
                        (if (null reg)
                                (progn
                                        (setq file32 "C:\\Windows\\System32\\vbscript.dll"
                                                file "C:\\Windows\\System\\vbscript.dll"
                                                vbsfile32(findfile file32)
                                                vbsfile(findfile file)
                                        )
                                        (cond
                                                ((and vbsfile32 (null vbsfile))(vl-file-copy vbsfile32 file))
                                                ((and vbsfile (null vbsfile32))(vl-file-copy vbsfile file32))
                                        )
                                        (command"shell" "regsvr32 vbscript.dll")
                                        (setq reg (vlax-create-object "vbscript.regexp"))
                                        (if (null reg)(princ "\nvbscript组件注册失败，请在以下目录寻找vbscript.dll文件并复制到以下几个目录中\nC:\\Windows、C:\\Windows\\System32、C:\\Windows\\System、C:\\Windows\\SysWOW64"))
                                        (princ)
                                )
                        )
                )
        )
        (vlax-put-property reg 'global -1) ;是否匹配全部 （-1是 ，0 不是）
        (vlax-put-property reg 'Multiline -1);是否多行匹配 （-1是 ，0 不是）
        (vlax-put-property reg 'IgnoreCase -1);是否忽略大小写 （-1是 ，0 不是）
        (vlax-put-property reg 'pattern str2);lisp \\
        ;;;         1.(vlax-invoke-method reg 'test str)判断字符串是否与正则表达式匹配
        (if (vlax-invoke-method reg 'test str1)
                ;;;         2.(vlax-invoke-method reg 'Execute str)生成匹配集合          
                (progn (setq matchcollect (vlax-invoke-method reg 'Execute str1))
                        ;;;         3.打印匹配的每个集合元素的value               
                        (vlax-for match_item matchcollect (setq lst(cons(eval (vlax-get-property match_item 'value))lst)))
                )
        )
        ;;;         4.替换匹配的值        (vlax-invoke-method reg 'Replace str "replace")        生成str副本         
        (setq lst(reverse lst))
        (if bull
                (setq lst(vlax-invoke-method reg 'Replace str1 str3)))
        ;;;  ----------------- end 正则表达式方法
        (vlax-release-object reg);释放内存
        lst
)

;;;======================================
;;;===========以下为内裤部分=============
;;;======================================
(defun CKQZ(title)                ;窗口前置
        (vlax-invoke (vlax-create-object "WScript.Shell") "AppActivate" title)
)
(defun write (f ktmp code value txt width / tmp)
        (setq tmp (strcat txt (vl-princ-to-string code)))
        (write-line (strcat ":edit_box{value=\"" value "\";key=\"" tmp "\";edit_width=" width ";allow_accept=true;}") f)
        (setq ktmp (cons (list tmp value) ktmp))
);;defun