设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 4444|回复: 10
打印 上一主题 下一主题

[模块/函数] 【Access小品】如何放屁 -- 再论压缩与解压

[复制链接]
跳转到指定楼层
1#
发表于 2015-5-21 17:33:56 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 todaynew 于 2015-5-21 18:06 编辑

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

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

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

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


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


本帖被以下淘专辑推荐:

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖1 订阅订阅

点击这里给我发消息

2#
发表于 2015-5-22 04:47:46 来自手机 | 只看该作者
好文章,赞一个
3#
发表于 2015-5-22 11:25:16 | 只看该作者
按这个函数处理的话,解压后的文件自动放在“我的文档”里:
Sub winrar()
Call RarX("C:\Program Files\WinRAR\WinRAR.exe", CurrentProject.Path & "\订单VArGAU.zip", CurrentProject.Path & "\备份\*.csv", "VArGAU")
End Sub
换句话说,即使存在“备份”文件夹,也不会放在“备份”文件夹中。还能改么?
4#
发表于 2015-5-22 13:51:44 | 只看该作者
我知道了。
  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
复制代码
5#
 楼主| 发表于 2015-5-22 14:03:32 | 只看该作者

点击这里给我发消息

6#
发表于 2015-5-23 11:14:37 | 只看该作者
学习啦
回复

使用道具 举报

7#
发表于 2015-5-28 10:28:17 | 只看该作者
todaynew  代码写得好,就是描述有点{:soso_e112:},不过还是谢谢了!
8#
发表于 2016-7-30 12:44:43 | 只看该作者
这个用得到,顶一个
9#
发表于 2016-8-20 11:24:06 | 只看该作者
已经下载学习,谢谢
10#
发表于 2017-7-28 17:26:58 | 只看该作者
谢谢
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-1 06:51 , Processed in 0.089826 second(s), 35 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表