利用dwx和archiveint.dll解压文件（找到一种解决方法）

sandyvs · 发表于 3 天前

本帖最后由 sandyvs 于 2025-12-10 17:10 编辑

;win11新版已支持解压rar，7z等格式，利用了libarchive，于是想应该有编译的dll可共利用，于是在system32里面找到了archiveint.dll，测试，是可用的
;当然，如果是win11新版可直接用http://bbs.mjtd.com/forum.php?mod=viewthread&tid=193807&extra=，不再局限于zip
;目前利用windows api设置当前目录解决解压路径问题
；函数说明及相关参考，Manpages of libarchive-dev in Debian unstable — Debian Manpages，http://bbs.mjtd.com/forum.php?mod=viewthread&tid=177292
;均为64为系统，32位也有对应的archiveint.dll，未测试；win10 64位，win11 64位测试可行，win7测试，缺部分dll不行；只测试了.zip，.rar，.7z
;没做容错处理，cad可能会崩@yxp

(setq fss (getfiled "请选择压缩文件" "F:\\桌面\\" "rar;zip;7z" 0))
(czx:regdwx nil);注册dwx
(setq DWX (vlax-create-object "DynamicWrapperX"))
(defun DWX_reg (func args rets)
(vlax-invoke DWX 'Register archdll func args rets)
)
(vlax-invoke DWX 'Register "kernel32.dll" "SetCurrentDirectoryW" "i=w" "r=l")
(setq path (strcat (vl-filename-directory fss) "\\cs"))
(vl-mkdir path)
(vlax-invoke DWX 'SetCurrentDirectoryW path)
(setq archdll (findfile "archiveint.dll"))
(DWX_reg "archive_read_new" "i=" "r=p") ;;; 基础句柄函数
(DWX_reg "archive_read_free" "i=p" "r=l");;; 基础句柄函数
(DWX_reg "archive_read_support_format_all" "i=p" "r=l"); ;; 格式/过滤器支持
(DWX_reg "archive_read_support_filter_all" "i=p" "r=l"); ;; 格式/过滤器支持
(DWX_reg "archive_read_open_filename" "i=psq" "r=l"); ;; 打开文件
(DWX_reg "archive_read_next_header" "i=pp" "r=l");;; 读取文件头
(DWX_reg "archive_read_extract" "i=ppl" "r=l");;解压文件
(DWX_reg "archive_read_close" "i=p" "r=l");;; 关闭归档
(setq Handle (vlax-invoke DWX 'archive_read_new))
(vlax-invoke DWX 'archive_read_support_format_all Handle)
(vlax-invoke DWX 'archive_read_support_filter_all Handle)
(vlax-invoke DWX 'archive_read_open_filename Handle fss 10240)
(setq uhead (vlax-invoke DWX 'MemAlloc 256 1))
(vlax-invoke DWX 'NumPut 0 uhead 0 "p")
(while (= 0 (vlax-invoke DWX 'archive_read_next_header Handle uhead))
(setq entry (vlax-invoke DWX 'NumGet uhead 0 "p"))
(vlax-invoke DWX 'archive_read_extract Handle entry 0)
(vlax-invoke DWX 'NumPut 0 uhead 0 "p")
)
(vlax-invoke DWX 'archive_read_close Handle) ;;rar 文件关闭
(vlax-invoke DWX 'archive_read_free Handle)
(vlax-invoke DWX 'MemFree uhead)

你有种再说一遍 · 发表于 3 天前

本帖最后由你有种再说一遍于 2025-12-9 17:35 编辑

sandyvs 发表于 2025-12-9 17:22
我现在纠结的是，调用解压文件的exe的话，无法判断是否解压完了，可能会导致后面的操作出错

恭喜你触发了:回调函数,回调地狱,异步,等相关编程概念.
基于你是lisp区域编程人员,本次将不会获得任何回答.

kozmosovia · 发表于 3 天前

免费解压软件遍地都有，犯不上单纯为了解压还要装DWX，写这么复杂的代码

taoyi0727 · 发表于前天 00:06

AI写的,只支持英文

[size=11.115pt]

(setq fss (getfiled "请选择压缩文件" "" "rar;zip;7z" 0))
(setq DWX (vlax-create-object "DynamicWrapperX"))
(defun DWX_reg (func args rets)
(vlax-invoke DWX 'Register archdll func args rets)
)
(setq path "C:\\temp\\")
(vl-mkdir path)
(setq archdll (findfile "archiveint.dll"))
(DWX_reg "archive_read_new" "i=" "r=p")
(DWX_reg "archive_read_free" "i=p" "r=l")
(DWX_reg "archive_read_support_format_all" "i=p" "r=l")
(DWX_reg "archive_read_support_filter_all" "i=p" "r=l")
(DWX_reg "archive_read_open_filename" "i=psq" "r=l")
(DWX_reg "archive_read_next_header" "i=pp" "r=l")
(DWX_reg "archive_entry_pathname" "i=p" "r=s")
(DWX_reg "archive_entry_set_pathname" "i=ps" "r=l")
(DWX_reg "archive_read_close" "i=p" "r=l")
(DWX_reg "archive_write_disk_new" "i=" "r=p")
(DWX_reg "archive_write_disk_set_options" "i=pl" "r=l")
(DWX_reg "archive_write_disk_set_standard_lookup" "i=p" "r=l")
(DWX_reg "archive_write_header" "i=pp" "r=l")
(DWX_reg "archive_write_finish_entry" "i=p" "r=l")
(DWX_reg "archive_write_close" "i=p" "r=l")
(DWX_reg "archive_write_free" "i=p" "r=l")
(DWX_reg "archive_read_data_block" "i=pppp" "r=l")
(DWX_reg "archive_write_data_block" "i=ppqq" "r=l")
(DWX_reg "archive_error_string" "i=p" "r=s")
(setq Handle (vlax-invoke DWX 'archive_read_new))
(vlax-invoke DWX 'archive_read_support_format_all Handle)
(vlax-invoke DWX 'archive_read_support_filter_all Handle)
(vlax-invoke DWX 'archive_read_open_filename Handle fss 10240)
(setq ext (vlax-invoke DWX 'archive_write_disk_new))
(vlax-invoke DWX 'archive_write_disk_set_options ext 3)
(vlax-invoke DWX 'archive_write_disk_set_standard_lookup ext)
(setq uhead (vlax-invoke DWX 'MemAlloc 8 1))
(vlax-invoke DWX 'NumPut 0 uhead 0 "p")
(setq pbuff (vlax-invoke DWX 'MemAlloc 8 1))
(setq psize (vlax-invoke DWX 'MemAlloc 8 1))
(setq poffset (vlax-invoke DWX 'MemAlloc 8 1))
(setq count 0)
(setq success 0)
(princ (strcat "\n开始解压到: " path "\n"))
(while (= 0 (vlax-invoke DWX 'archive_read_next_header Handle uhead))
(setq entry (vlax-invoke DWX 'NumGet uhead 0 "p"))
(setq fname (vlax-invoke DWX 'archive_entry_pathname entry))
(setq targetpath (strcat path fname))
(setq targetpath (vl-string-translate "/" "\\" targetpath))
(setq targetdir (vl-filename-directory targetpath))
(if targetdir
(if (not (vl-file-directory-p targetdir))
(vl-mkdir targetdir)
)
)
(vlax-invoke DWX 'archive_entry_set_pathname entry targetpath)
(setq r (vlax-invoke DWX 'archive_write_header ext entry))
(princ (strcat "\n 写入头: " (itoa r) " - " targetpath))
(if (< r 0)
(princ (strcat "\n 错误: " (vlax-invoke DWX 'archive_error_string ext)))
)
(if (>= r 0)
(progn
(while (= 0 (setq r (vlax-invoke DWX 'archive_read_data_block Handle pbuff psize poffset)))
(setq buff (vlax-invoke DWX 'NumGet pbuff 0 "p"))
(setq size (vlax-invoke DWX 'NumGet psize 0 "q"))
(setq offset (vlax-invoke DWX 'NumGet poffset 0 "q"))
(setq wr (vlax-invoke DWX 'archive_write_data_block ext buff size offset))
(if (< wr 0)
(setq r -1)
)
)
(if (= r 1)
(progn
(vlax-invoke DWX 'archive_write_finish_entry ext)
(setq success (1+ success))
(princ (strcat "\n✓ " fname))
)
(princ (strcat "\n✗ " fname " (数据错误)"))
)
)
)
(setq count (1+ count))
(vlax-invoke DWX 'NumPut 0 uhead 0 "p")
)
(vlax-invoke DWX 'archive_write_close ext)
(vlax-invoke DWX 'archive_write_free ext)
(vlax-invoke DWX 'archive_read_close Handle)
(vlax-invoke DWX 'archive_read_free Handle)
(vlax-invoke DWX 'MemFree pbuff)
(vlax-invoke DWX 'MemFree psize)
(vlax-invoke DWX 'MemFree poffset)
(vlax-invoke DWX 'MemFree uhead)
(princ (strcat "\n\n完成！成功: " (itoa success) "/" (itoa count)))
(princ (strcat "\n位置: " path))
(princ)

sandyvs · 发表于 3 天前

kozmosovia 发表于 2025-12-9 17:01
免费解压软件遍地都有，犯不上单纯为了解压还要装DWX，写这么复杂的代码

我现在纠结的是，调用解压文件的exe的话，无法判断是否解压完了，可能会导致后面的操作出错

sandyvs · 发表于 3 天前

你有种再说一遍发表于 2025-12-9 17:31
恭喜你触发了:回调函数,回调地域,异步,等相关编程概念.
基于你是lisp区域编程人员,本次将不会获得任何回 ...

好好，有时间学C#

kozmosovia · 发表于 3 天前

sandyvs 发表于 2025-12-9 17:22
我现在纠结的是，调用解压文件的exe的话，无法判断是否解压完了，可能会导致后面的操作出错

如果知道被压缩的文件个数，可以用while核查解压目标文件夹是否文件数目已经达到设定值。
另外的方式是用WSH实现EXEWAIT。

sandyvs · 发表于 3 天前

kozmosovia 发表于 2025-12-9 17:35
如果知道被压缩的文件个数，可以用while核查解压目标文件夹是否文件数目已经达到设定值。
另外的方式是 ...

也不好弄，可能过段时间会更新压缩包，不能没更新一次再改次个数吧。。
用WSH实现EXEWAIT 还没研究过

kozmosovia · 发表于 3 天前

本帖最后由 kozmosovia 于 2025-12-9 22:52 编辑

那就while时候去catch vl-file-delete zip文件，解压完成了，压缩文件就可以被正常删除了
如果不希望删除压缩文件，那就先复制一个副本到临时目录，再从副本解压并删除副本

sandyvs · 发表于前天 09:55

kozmosovia 发表于 2025-12-9 20:10
那就while时候去catch vl-file-delete zip文件，解压完成了，压缩文件就可以被正常删除了
如果不希望删除 ...

这也是个办法

账号		自动登录	找回密码
密码			注册

[讨论] 利用dwx和archiveint.dll解压文件（找到一种解决方法）

本帖子中包含更多资源

评分

浏览过的版块