【Access小品】如何放屁 -- 再论压缩与解压

todaynew

　　很久很久以前写过一个《斗天斗地斗引号---Rar压缩及解压文件示例》，在这个示例中对Rar的压缩和解压做了一些浅显的论述。今日里，版友“这是我的小号”同志希望借用这个示例，进一步折腾出带密码的压缩与解压功能来。于是乎“这是我的小号”同志在网上找了一些资料，发现只需要加一个ｐ开关就应该可以了，于是他将Rar的解压命令写做“ x -p ”。一测试，弹出了Rar的密码对话框。这当然不是版友“这是我的小号”同志所希望的。

　　为什么会这样呢？我们先来分析一下。版友“这是我的小号”同志放了一个ｐ，这个ｐ表示一个Rar的开关。但版友“这是我的小号”同志并没有告诉Rar这个ｐ到底是个什么调调。所以这个ｐ实际并没放响，只是告诉Rar打算放个ｐ。好在Rar也很聪明，便弹出一个对话框，问版友“这是我的小号”同志这个ｐ是怎么个放法。到此，我们便知道了版友“这是我的小号”同志放的ｐ出现了什么问题－－没有进一步写入密码。所以正确的写法是：“ x -p123 ”（假设密码是123）。

　　Rar命令行（也包括其他命令行）含有开关，开关由“-”符号加一个有特定含义的字母构成，有些开关是不带参数的，但有些就需要带参数。密码的开关是个ｐ，可以带参数也可以不带参数。不带参数时，仅表示压缩或解压时需要密码，于是由Rar弹出对话框来进一步确认密码；带参数时，Rar就在压缩或解压时，按照密码参数进行操作，除非输入密码是错误的，否则不会弹出对话框再询问什么。

　　放个ｐ不难，难的是明白如何放ｐ。明白了这一点，ｐ才能放得响彻云霄，惊天动地。放ｐ论述完了，但总是还要给“这是我的小号”同志一个交代，不能空谈误国。于是便将原例中的相关代码做了一个修改。


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

zpy2

好文章，赞一个

这是我的小号

按这个函数处理的话，解压后的文件自动放在“我的文档”里：
Sub winrar()
Call RarX("C:\Program Files\WinRAR\WinRAR.exe", CurrentProject.Path & "\订单VArGAU.zip", CurrentProject.Path & "\备份\*.csv", "VArGAU")
End Sub
换句话说，即使存在“备份”文件夹，也不会放在“备份”文件夹中。还能改么？

这是我的小号

我知道了。

1. Public Function RarX(ByVal RAR As String, ByVal RARname As String, ByVal fldname As String, Optional password As String)
   
2.     '功能:解压文件
   
3.     '参数:RAR --RAR地址
   
4.     '     RARname---压缩文件名（含路径）
   
5.     '     fldname---解压的文件夹名（含路径）
   
6.     '示例:RarX "C:\Program Files\WinRAR\WinRAR.exe",CurrentProject.Path & "\备份\后台备份.rar",CurrentProject.Path & "\备份\*.mdb","123"
   
7.     Dim cmd As String
   
8.     If Nz(password, "") = "" Then
   
9.         cmd = " x "
   
10.     Else
    
11. '加个-o才可以把文件解压到指定文件夹。否则默认解压到“我的文档”
    
12.         cmd = " x -o -p{0} "
    
13.         cmd = ReplaceValues(cmd, password)
    
14.     End If
    
15.     Call Shell(RAR & cmd & """" & RARname & """ *.* """ & fldname & """", vbNormalFocus)
    
16. End Function

复制代码

todaynew

这是我的小号 发表于 2015-5-22 13:51
我知道了。

cpxie

学习啦

purplerose

todaynew  代码写得好，就是描述有点{:soso_e112:}，不过还是谢谢了！

李力军2

这个用得到,顶一个

owen2016

已经下载学习，谢谢

access新新新手

谢谢