LISP实现文件解压功能（无需系统安装解压软件）

yxp

可以在你的 CAD 工具包里调用 LISP 解压缩。

运行以下程序需要系统注册  dynwrapx.dll，详见 DWX中文说明，
另外，需要将 UnRAR64.dll 下载到你的 CAD 支持目录。

1. ;;Lisp 调用解压缩库文件示例，明经通道，by yxp 2022-2-2
   
2. (vl-load-com)
   
3. (defun c:urar (/ RARopen fsleng fn sn)
   
4.   (setq sfilePath (if sfilePath (strcat sfilePath "\\") ""))
   
5.   (setq fss    (getfiled "请选择压缩文件" sfilePath "rar" 0)
   
6.         DWX    (vlax-create-object "DynamicWrapperX")
   
7.         Rardll (findfile "UnRAR64.dll"))
   
8.   (defun DWX_reg (func args rets)
   
9.     (vlax-invoke DWX 'Register Rardll func args rets)
   
10.   )
    
11.   (if (and fss DWX Rardll)
    
12.     (progn
    
13.       (DWX_reg "RAROpenArchive" "i=p" "r=p") ;;打开压缩包
    
14.       (DWX_reg "RARReadHeader" "i=pp" "r=p") ;;读取压缩包文件头
    
15.       (DWX_reg "RARProcessFile" "i=huss" "r=l") ;;文件解压缩
    
16.       (DWX_reg "RARCloseArchive" "i=p" "r=l") ;;关闭压缩包
    
17.       (setq RARopen   (vlax-invoke DWX 'MemAlloc 36 1)
    
18.             sfilePath (vl-filename-directory fss)
    
19.             fsleng    (+ (strlen fss) 1)
    
20.             pRarfs    (vlax-invoke DWX 'MemAlloc fsleng 1)
    
21.       )
    
22.       (vlax-invoke DWX 'StrPut fss pRarfs "s")
    
23.       (vlax-invoke DWX 'NumPut pRarfs RARopen "p")
    
24.       (vlax-invoke DWX 'NumPut 1 RARopen 8 "u") ;;解压模式
    
25.       (setq Handle (vlax-invoke DWX 'RAROpenArchive RARopen)
    
26.             uhead  (vlax-invoke DWX 'MemAlloc 576 1))
    
27.       (while (= 0 (vlax-invoke DWX 'RARReadHeader Handle uhead))
    
28.         (setq fn (vlax-invoke DWX 'StrGet uhead 260 "s")
    
29.               sn (vlax-invoke DWX 'NumGet uhead 528 "u"))
    
30.         (princ (strcat "\n正在解压: " fn ", " (itoa sn) "字节"))
    
31.         (vlax-invoke DWX 'RARProcessFile Handle 2 sfilePath "")
    
32.       )
    
33.       (vlax-invoke DWX 'RARCloseArchive Handle) ;;rar 文件关闭
    
34.       (vlax-invoke DWX 'MemFree uhead)
    
35.     )
    
36.   )
    
37.   (princ)
    
38. )
    

;;Lisp 调用解压缩库文件示例，明经通道，by yxp 2022-2-2<br /> (vl-load-com)<br /> (defun c:urar (/ RARopen fsleng fn sn)<br />   (setq sfilePath (if sfilePath (strcat sfilePath "\\") ""))<br />   (setq fss    (getfiled "请选择压缩文件" sfilePath "rar" 0)<br />         DWX    (vlax-create-object "DynamicWrapperX")<br />         Rardll (findfile "UnRAR64.dll"))<br />   (defun DWX_reg (func args rets)<br />     (vlax-invoke DWX 'Register Rardll func args rets)<br />   )<br />   (if (and fss DWX Rardll)<br />     (progn<br />       (DWX_reg "RAROpenArchive" "i=p" "r=p") ;;打开压缩包<br />       (DWX_reg "RARReadHeader" "i=pp" "r=p") ;;读取压缩包文件头<br />       (DWX_reg "RARProcessFile" "i=huss" "r=l") ;;文件解压缩<br />       (DWX_reg "RARCloseArchive" "i=p" "r=l") ;;关闭压缩包<br />       (setq RARopen   (vlax-invoke DWX 'MemAlloc 36 1)<br />             sfilePath (vl-filename-directory fss)<br />             fsleng    (+ (strlen fss) 1)<br />             pRarfs    (vlax-invoke DWX 'MemAlloc fsleng 1)<br />       )<br />       (vlax-invoke DWX 'StrPut fss pRarfs "s")<br />       (vlax-invoke DWX 'NumPut pRarfs RARopen "p")<br />       (vlax-invoke DWX 'NumPut 1 RARopen 8 "u") ;;解压模式<br />       (setq Handle (vlax-invoke DWX 'RAROpenArchive RARopen)<br />             uhead  (vlax-invoke DWX 'MemAlloc 576 1))<br />       (while (= 0 (vlax-invoke DWX 'RARReadHeader Handle uhead))<br />         (setq fn (vlax-invoke DWX 'StrGet uhead 260 "s")<br />               sn (vlax-invoke DWX 'NumGet uhead 528 "u"))<br />         (princ (strcat "\n正在解压: " fn ", " (itoa sn) "字节"))<br />         (vlax-invoke DWX 'RARProcessFile Handle 2 sfilePath "")<br />       )<br />       (vlax-invoke DWX 'RARCloseArchive Handle) ;;rar 文件关闭<br />       (vlax-invoke DWX 'MemFree uhead)<br />     )<br />   )<br />   (princ)<br /> )<br />

流氓兔

神器。。

你有种再说一遍

那就可以lisp读写pmp了,嘻嘻

yxp

你有种再说一遍 发表于 2022-2-5 20:51
那就可以lisp读写pmp了,嘻嘻

有缺点，不能读取分卷压缩包，不能解压有密码的压缩包，因为 lisp 无法回调。

taoyi0727

可以可以,我试了下,可以解压
刚开始我以为要用命令NETLOAD加载dll  后来发现不用   见笑了

这个能压缩文件吗?

yxp

taoyi0727 发表于 2022-2-5 21:59
可以可以,我试了下,可以解压
刚开始我以为要用命令NETLOAD加载dll  后来发现不用   见笑了

rar 官方并未提供压缩文件的 dll，可以调用 rar 命令行压缩。或者，这种 dll 很多，7z 压缩似乎有提供，去官方网站能找到，还可以下载到 c++\c# 压缩算法的源码

zixuan203344

按照这趋势，有一天在CAD+Lisp环境下玩王者荣耀我都不觉得奇怪

谢雷锋

zixuan203344 发表于 2022-2-9 22:37
按照这趋势，有一天在CAD+Lisp环境下玩王者荣耀我都不觉得奇怪

邹锋

厉害，谢谢，但是还要加载CAD，