TA的每日心情 | 开心 2024-8-31 15:58 |
---|
签到天数: 89 天 [LV.6]常住居民II
管理员
- 积分
- 3366
|
本帖最后由 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 |
|