Office中国论坛/Access中国论坛

标题: 【求助】如何使用shell函数调用winrar解压带密码的文件？ [打印本页]

作者: 这是我的小号 时间: 2015-5-21 15:12
标题: 【求助】如何使用shell函数调用winrar解压带密码的文件？
查找了todaynew大师的作品：
http://www.office-cn.net/thread-93465-1-1.html
但是遗憾的是，没有关于带密码的解压方式。按网上说的-s开关也好，-p开关也好，都没有解决问题。大家看看能不能帮忙看看？
附件里的压缩包后六位字符串为解压密码
[attach]56358[/attach]

作者: todaynew 时间: 2015-5-21 15:59
很简单呀
假设你的密码是123，则压缩和解压的自定义函数修改为：
Function RarA(RAR As String, RARname As String, filname As String)
'功能:压缩文件
'参数:RAR --RAR地址
'    RARname---压缩文件名（含路径）
'    filname---被压缩的文件名或文件夹名（含路径）
'示例:压缩文件 "C:\Program Files\WinRAR\WinRAR.exe",CurrentProject.Path & "\备份\后台备份.rar",CurrentProject.Path & "\备份\*.mdb"
Call Shell(RAR & " a -r -ep -df -p123 """ & RARname & """ """ & filname & """", vbNormalFocus)
End Function

Function RarX(RAR As String, RARname As String, fldname As String)
'功能:解压文件
'参数:RAR --RAR地址
'    RARname---压缩文件名（含路径）
'    fldname---解压的文件夹名（含路径）
'示例:压缩文件 "C:\Program Files\WinRAR\WinRAR.exe",CurrentProject.Path & "\备份\后台备份.rar",CurrentProject.Path & "\备份\*.mdb"
Call Shell(RAR & " x -p123 """ & RARname & """ *.* """ & fldname & """", vbNormalFocus)
End Function

作者: 这是我的小号 时间: 2015-5-21 16:35

todaynew 发表于 2015-5-21 15:59
很简单呀
假设你的密码是123，则压缩和解压的自定义函数修改为：
Function RarA(RAR As String, RARname ...

不对不对

之前我也是按网上说的-p来测试，同样无法解压。我希望的结果是在函数里输入密码即可解压，而不需要弹出来。
而现在执行时会弹出输入密码的对话框，但是输入后不仅不解压，还说找不到文件。
麻烦您帮我看看附件的写法有没有问题。
[attach]56360[/attach]
[attach]56361[/attach]
[attach]56359[/attach]

作者: todaynew 时间: 2015-5-21 16:47
本帖最后由 todaynew 于 2015-5-21 16:55 编辑

这是我的小号发表于 2015-5-21 16:35
不对不对之前我也是按网上说的-p来测试，同样无法解压。我希望的结果是在函数里输入密码即可解压，而不 ...

你光放一个空p当然不行。

你放个空p，意思就是打算放p，于是RAR就跳出对话框问你放个什么p，所以这是正常反应。如果你在p后面写密码，RAR就知道你的p是个什么调调，也就不会弹出对话框再问你什么了。

更通用的搞法可以这样：

Function RarA(ByVal RAR As String, ByVal RARname As String, ByVal filname As String, Optional password As String)
'功能:压缩文件
'参数:RAR --RAR地址
'    RARname---压缩文件名（含路径）
'    filname---被压缩的文件名或文件夹名（含路径）
'示例:压缩文件 "C:\Program Files\WinRAR\WinRAR.exe",CurrentProject.Path & "\备份\后台备份.rar",CurrentProject.Path & "\备份\*.mdb","123"
Dim cmd As String
If Nz(password, "") = "" Then
      cmd = " a -r -ep -df "
Else
      cmd = " a -r -ep -df -p{0} "
      cmd = ReplaceValues(cmd, password)
End If

Call Shell(RAR & cmd & """" & RARname & """ """ & filname & """", vbNormalFocus)
End Function

Function RarX(ByVal RAR As String, ByVal RARname As String, ByVal fldname As String, Optional password As String)
'功能:解压文件
'参数:RAR --RAR地址
'    RARname---压缩文件名（含路径）
'    fldname---解压的文件夹名（含路径）
'示例:压缩文件 "C:\Program Files\WinRAR\WinRAR.exe",CurrentProject.Path & "\备份\后台备份.rar",CurrentProject.Path & "\备份\*.mdb","123"
Dim cmd As String
If Nz(password, "") = "" Then
      cmd = " x "
Else
      cmd = " x -p{0} "
      cmd = ReplaceValues(cmd, password)
End If
Call Shell(RAR & cmd & """" & RARname & """ *.* """ & fldname & """", vbNormalFocus)
End Function

Public Function ReplaceValues(ByVal str As String, ParamArray pArr() As Variant) As String
'功能：模仿.Net中的String.Format方法
Dim str1  As String
Dim num As String
Dim i As Integer
str1 = str
For i = 0 To UBound(pArr)
      num = "{" & i & "}"
      str1 = Replace(str1, num, pArr(i))
Next
ReplaceValues = str1
End Function

作者: 这是我的小号 时间: 2015-5-21 17:08
问题在于解压完之后，文件都不知道放哪里了{:soso_e109:}{:soso_e109:}
解压时提示已经有文件了
[attach]56362[/attach]
但是实际上跟MH370一样，失踪了{:soso_e109:}{:soso_e109:}
[attach]56363[/attach]

[attach]56364[/attach]

作者: todaynew 时间: 2015-5-21 17:32

这是我的小号发表于 2015-5-21 17:08
问题在于解压完之后，文件都不知道放哪里了
解压时提示已经有文件了

使劲找

作者: zpy2 时间: 2015-5-22 05:07
在备份文件夹

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)