很久很久以前写过一个《斗天斗地斗引号---Rar压缩及解压文件示例》,在这个示例中对Rar的压缩和解压做了一些浅显的论述。今日里,版友“这是我的小号”同志希望借用这个示例,进一步折腾出带密码的压缩与解压功能来。于是乎“这是我的小号”同志在网上找了一些资料,发现只需要加一个p开关就应该可以了,于是他将Rar的解压命令写做“ x -p ”。一测试,弹出了Rar的密码对话框。这当然不是版友“这是我的小号”同志所希望的。
为什么会这样呢?我们先来分析一下。版友“这是我的小号”同志放了一个p,这个p表示一个Rar的开关。但版友“这是我的小号”同志并没有告诉Rar这个p到底是个什么调调。所以这个p实际并没放响,只是告诉Rar打算放个p。好在Rar也很聪明,便弹出一个对话框,问版友“这是我的小号”同志这个p是怎么个放法。到此,我们便知道了版友“这是我的小号”同志放的p出现了什么问题--没有进一步写入密码。所以正确的写法是:“ x -p123 ”(假设密码是123)。
Public Function RarA(ByVal RAR As String, ByVal RARname As String, ByVal filname As String, Optional password As String)
'功能:压缩文件
'参数:RAR --RAR地址
' RARname---压缩文件名(含路径)
' filname---被压缩的文件名或文件夹名(含路径)
'示例:RarA "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
Public Function RarX(ByVal RAR As String, ByVal RARname As String, ByVal fldname As String, Optional password As String)
'功能:解压文件
'参数:RAR --RAR地址
' RARname---压缩文件名(含路径)
' fldname---解压的文件夹名(含路径)
'示例:RarX "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