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

本帖最后由 yxp 于 2022-2-4 22:59 编辑

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

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

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

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

网友答:

神器。。

网友答: 那就可以lisp读写pmp了,嘻嘻

网友答:

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

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

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

这个能压缩文件吗?

网友答:

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

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

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

网友答:

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

网友答: 厉害，谢谢，但是还要加载CAD，

网友答: 附件64位前面多了X，，很久才发现问题所在

上一篇：【分享系列1】grread函数应用例子大汇总，源码分

下一篇：没有了