Board logo

标题: [问题求助] 【已解决】VBS如何根据文件数量解压? [打印本页]

作者: zhanglei1371    时间: 2014-7-12 08:31     标题: 【已解决】VBS如何根据文件数量解压?

本帖最后由 zhanglei1371 于 2014-7-19 13:47 编辑

如果想做到:拖动多个rar压缩文件到vbs后,如果是有多个文件,则解压到文件夹,若有文件夹或只有一个文件,则直接解压?
作者: Batcher    时间: 2014-7-12 11:15

安装WinRAR了吗?
作者: zhanglei1371    时间: 2014-7-12 16:20

回复 2# Batcher


    当然安装了。
系统rar右键当然可以解压缩。不过我需要的是职能判断,压缩包根目录只有一个文件或文件夹就直接解压,否则就解压到文件夹。更加方便了。
最终目的是建立系统快捷键如alt+R,选中文件后一按,不用点右键,就自动解压了。
版主该明白我的意思吧???
作者: yu2n    时间: 2014-7-12 16:30

  1. Dim fso, nFolder, nFile
  2. nFile = 0
  3. nFolder = 0
  4. Set fso=CreateObject("Scripting.FilesyStemObject")
  5. For Each arg In WScript.Arguments
  6.   If fso.FileExists(arg) Then nFile = nFile + 1
  7.   If fso.FolderExists(arg) Then nFolder = nFolder + 1
  8. Next
  9. WScript.Echo nFile & "个文件, " & nFolder & "个文件夹"
  10. If nFile > 1 And nFolder = 0 Then
  11.   WScript.Echo "执行1:RAR 解压到文件夹……"
  12. ElseIf nFolder > 0 Or nFile = 1 Then
  13.   WScript.Echo "执行2:RAR 直接解压……"
  14. End If
复制代码
混乱。
楼主要先换个语文老师,然后找计算机老师学RAR命令,之后在代码执行1/2里面写命令就行了……
作者: yu2n    时间: 2014-7-12 17:18

回复  Batcher


    当然安装了。
系统rar右键当然可以解压缩。不过我需要的是职能判断,压缩包根目录 ...
zhanglei1371 发表于 2014-7-12 16:20


其实你可以自己分析:
导出列表
"C:\Program Files\WinRAR\RAR.exe" -v  "d:\1.rar"

结果如下:
  1. RAR 3.70 beta 8    版权 (C) 1993-2007 Alexander Roshal    5 五月 2007
  2. 已注册给 Mittal Steel Temirtau
  3. 压缩文件 d:\1.rar
  4. 路径名/注释
  5.                   尺寸   压缩率  日期   时间     属性      CRC   方法 版本
  6. -------------------------------------------------------------------------------
  7. 1\2\6.txt
  8.                      0        0   0% 12-07-14 17:12  .....A.   00000000 m0b 2.9
  9. 1\3\7\6.txt
  10.                      0        0   0% 12-07-14 17:12  .....A.   00000000 m0b 2.9
  11. 1\4.txt
  12.                      0        0   0% 12-07-14 17:12  .....A.   00000000 m0b 2.9
  13. 1\3\7
  14.                      0        0   0% 12-07-14 17:12  .D.....   00000000 m0  2.0
  15. 1\2
  16.                      0        0   0% 12-07-14 17:12  .D.....   00000000 m0  2.0
  17. 1\3
  18.                      0        0   0% 12-07-14 17:12  .D.....   00000000 m0  2.0
  19. 1
  20.                      0        0   0% 12-07-14 17:12  .D.....   00000000 m0  2.0
  21. -------------------------------------------------------------------------------
  22.     7                0        0   0%
复制代码
属性“.....A.”为文件,属性“.D.....”为文件夹,遍历文本统计一下个数就知道了……
作者: Batcher    时间: 2014-7-12 21:17

回复 3# zhanglei1371


    有的人用WinRAR,有的人用7-Zip,有的人用好压......你明白我在2楼那个回复的意思了吗?
作者: zhanglei1371    时间: 2014-7-13 09:13

回复 4# yu2n


    大侠,你理解错了,nfiles是选中的总数,我不是根据nfiles来判断的。
而是:当选中10个rar压缩包时,当其中有6个不是以文件夹的形式压缩时,在解压时就自动创建文件夹,然后解压到文件夹中,否则如果是以文件夹的形式压缩的,就直接解压了。
我的目的是:解压后不出现很多杂乱文件的情况。如果右键-rar-解压到目录的话,可能会出现两层目录,每次都是先双击打开看看是否以文件夹压缩的,然后再判断直接解压还是解压到目录。
看你的代码就差一步了,能否继续完善下,谢谢。
另外,我的最终目的是:左键选中压缩文件——直接按快捷键alt+R即执行解压缩,你如果会ahk的话,或者有其他的方法难能实现我这个最终目的,那就真是太好了!
作者: czjt1234    时间: 2014-7-13 15:42

本帖最后由 czjt1234 于 2014-7-13 15:43 编辑

快捷键的话,把文件发送到桌面快捷方式,就可以设置

判断rar里的文件夹和文件数目,不会

或者可以用这个思路:
先解压到文件夹,再判断二级文件夹和文件数目,符合的剪切二级文件夹到一级目录

你好象有点系统洁癖的啊
作者: zhanglei1371    时间: 2014-7-13 23:12

回复 8# czjt1234


    准备学习AHK,用Ahk来实现这个功能。一切为了方便!
作者: yu2n    时间: 2014-7-16 15:59

本帖最后由 yu2n 于 2015-1-4 01:14 编辑

回复 7# zhanglei1371
首先,抱歉来晚了。因为我又换了个语文老师重新学习了中华民族语言文化~~~
尝试着理解了一下:

条件1. 压缩包里面只有有一个文件,或只有一个文件夹
解决1. 直接解压

条件2. 在条件1之外的情况
解决2. 解压到以该压缩文件命名的文件夹

代码我贴在下面,如果有其他条件你可以自己改,写的够详细了……

VBS + WinRAR 3.7
  1. Main
  2. Sub Main
  3.   ' 以命令行模式运行,可去掉(需要同时去掉WScript.Echo部分)
  4.   If InStr(1,WScript.FullName&"|","WScript.exe|",1)>0 Then
  5.     Dim i, sArgs
  6.     For i = 1 To WScript.Arguments.Count
  7.       sArgs = sArgs & " " & Chr(34) & WScript.Arguments(i-1) & Chr(34)
  8.     Next
  9.     CreateObject("WScript.Shell").Run("CScript.exe " & Chr(34) & Wscript.ScriptFullName & Chr(34) & sArgs),3
  10.     WScript.Quit(0)
  11.   End If
  12.   ' 获取参数
  13.   If WScript.Arguments.Count = 0 Then
  14.     WScript.Echo "提示:没有参数。"
  15.     WScript.Quit(1)
  16.   Else
  17.     For Each arg In WScript.Arguments
  18.       Check arg
  19.     Next
  20.     WScript.Quit(0)
  21.   End If
  22. End Sub
  23. ' 检查RAR文件,执行相应操作
  24. Sub Check(file_rar)
  25.   Set wso = CreateObject("WScript.Shell")
  26.   Set fso = CreateObject("Scripting.FileSystemObject")
  27.   ' 检测参数
  28.   If Not fso.FileExists(file_rar) Then
  29.     WScript.Echo "提示:参数不正确。"
  30.     WScript.Quit(2)
  31.   End If
  32.   ' 检查 RAR.EXE 是否存在
  33.   RAR_EXE = wso.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\WinRAR.exe\path") & "\rar.exe"
  34.   RAR_EXE = fso.getFile(RAR_EXE).ShortPath
  35.   If Not fso.FileExists(RAR_EXE) Then
  36.     WScript.Echo "提示:没有找到 RAR.exe,将退出程序。"
  37.   End If
  38.   ' 获取临时文件位置,以便于保存列表
  39.   wso.CurrentDirectory = wso.ExpandenVironmentStrings("%temp%")
  40.   file_log = wso.ExpandenVironmentStrings("%temp%") & "\" & fso.GetTempName
  41.   Set oExec = wso.Exec("cmd.exe")
  42.   oExec.StdIn.WriteLine RAR_EXE & " v """ & file_rar & """>""" & file_log & """"
  43.   oExec.StdIn.WriteLine "exit"
  44.   errMsg = oExec.StdErr.ReadAll()
  45.   stdMsg = oExec.StdOut.ReadAll()
  46.   'WScript.Echo "errMsg:" & errMsg & "stdMsg:" & stdMsg
  47.   ' 分析文件列表,取出对应的因素
  48.   Dim bStart, bEnd, strLine, arrLog()
  49.   ReDim Preserve arrLog(1,1)
  50.   Set rTxt = fso.OpenTextFile(fso.GetFile(file_log).Path, 1)
  51.   Do Until rTxt.AtEndOfStream
  52.     '逐行读取
  53.     strLine = Trim(rTxt.ReadLine())
  54.     If strLine=String(79,"-") Then  ' 开始、结束标记
  55.       If bStart=False Then
  56.         bStart = True
  57.         nLine = 0
  58.       Else
  59.         bEnd = True
  60.         Exit Do
  61.       End If
  62.     Else
  63.       If bStart=True Then
  64.         nSplit = Fix(nLine/2)
  65.         ReDim Preserve arrLog(1, nSplit)
  66.         nLine = nLine + 1
  67.         If nLine Mod 2 <> 0 Then
  68.           ' 文件路径
  69.           WScript.Echo nLine & " Path: " & Trim(strLine)
  70.           arrLog(0, nSplit) = Trim(strLine)
  71.         ElseIf regEx_test("[\.A-Z]{7}", strLine)=True Then
  72.           ' 属性
  73.           WScript.Echo nLine & " Attr: " & Trim(Join(regEx_execute("[\.A-Z]{7}", strLine), ""))
  74.           arrLog(1, nSplit) = Trim(Join(regEx_execute("[\.A-Z]{7}", strLine), ""))
  75.         End If
  76.       End If
  77.     End If
  78.   Loop
  79.   rTxt.close  
  80.   ' 分析每一个因素
  81.   Dim i, nRoot, nFile, nFolder
  82.   nRoot = 0
  83.   nFile = 0
  84.   nFolder = 0
  85.   For i = 0 To UBound(arrLog, 2)
  86.     ' 统计文件夹个数
  87.     If InStr(arrLog(1, i), "D") >0 Then nFolder = nFolder + 1
  88.     ' 统计文件个数
  89.     If InStr(arrLog(1, i), "A") >0 Then nFile = nFile + 1
  90.     ' 统计在根目录下的文件或文件夹个数
  91.     If Not InStr(arrLog(0, i), "\") >0 Then nRoot = nRoot + 1
  92.   Next
  93.   WScript.Echo "该压缩文件含:" & nFolder & "个文件夹," & nFile & "个文件。"
  94.   WScript.Echo "该压缩文件根目录下有" & nRoot & "个文件、或文件夹。"
  95.   If nRoot = 1 Then
  96.     WScript.Echo "执行1:RAR 直接解压……"
  97.     Msgbox "执行1:RAR 直接解压……"
  98.     fp = fso.GetFile(file_rar).ParentFolder  ' 文件所在的文件夹路径
  99.     If Right(fp,1)<>"\" Then fp = fp & "\"
  100.     wso.Run """" & RAR_EXE & """ x -r -y """ & file_rar & """ """ & fp & """"
  101.   Else
  102.     WScript.Echo "执行2:RAR 解压到文件夹……"
  103.     Msgbox "执行2:RAR 解压到文件夹……"
  104.     fp = fso.GetFile(file_rar).ParentFolder
  105.     If Right(fp,1)<>"\" Then fp = fp & "\"
  106.     fp = fp & Left(fso.GetFileName(file_rar), Len(fso.GetFileName(file_rar))-Len(fso.GetExtensionName(file_rar))-1)
  107.     If Right(fp,1)<>"\" Then fp = fp & "\"
  108.     wso.Run """" & RAR_EXE & """ x -r -y """ & file_rar & """ """ & fp & """"
  109.   End If
  110. End Sub
  111. ' 取得正则表达式搜索结果,返回数组
  112. Function regEx_execute(ByVal sPattern, ByVal str)
  113.   Dim regEx, Match, Matches, arrMatchs(), i : i = -1  ' 建立变量。
  114.   Set regEx = CreateObject("VBScript.RegExp") ' 建立正则表达式。
  115.     regEx.Pattern = sPattern    ' 设置模式。
  116.     regEx.IgnoreCase = True  ' 设置是否区分字符大小写。
  117.     regEx.Global = True    ' 设置全局可用性。
  118.     regEx.MultiLine = True   ' 多行匹配模式
  119.   Set Matches = regEx.Execute(str)    ' 执行搜索。
  120.   For Each Match in Matches  ' 遍历匹配集合。
  121.     If Not Match.Value = "" Then
  122.       i = i + 1
  123.       ReDim Preserve arrMatchs(i) ' 动态数组:数组随循环而变化
  124.       arrMatchs(i) = Match.Value
  125.     End If
  126.   Next
  127.   regEx_execute = arrMatchs
  128.   Set Match = Nothing
  129.   Set regEx = Nothing
  130. End Function
  131. ' 正则表达式测试
  132. Function regEx_test(ByVal sPattern, ByVal str)
  133.   Dim regEx, Match, Matches           ' 建立变量。
  134.   Set regEx = CreateObject("VBScript.RegExp") ' 建立正则表达式。
  135.     regEx.Pattern = sPattern   ' 设置模式。
  136.     regEx.IgnoreCase = True  ' 设置是否区分字符大小写。
  137.     regEx.Global = True    ' 设置全局可用性。
  138.     regEx.MultiLine = True   ' 多行匹配模式
  139.   regEx_test = regEx.Test(str)
  140.   Set regEx = Nothing
  141. End Function
复制代码

作者: zhanglei1371    时间: 2014-7-16 20:25

回复 10# yu2n


    非常感谢yu2n的热心关注!
不是您语文不好,是问题不容易表述清楚。代码我试了下,对于多个文件的可以自动建立目录,但是如果多个文件在文件夹里还会多建立,为此,我做了几个压缩包,第一二个要求建立文件夹后解压,第三个第四个要求直接解压
回复 10# yu2n
作者: yu2n    时间: 2014-7-16 21:04

回复 11# zhanglei1371


应该是WinRAR版本问题,请你自行修改日志分析的部分吧:
我的代码是按RAR 3.70编写的,与最新的RAR 5.10是有区别的。

RAR 3.70 beta 8
  1. RAR 3.70 beta 8    版权 (C) 1993-2007 Alexander Roshal    5 五月 2007
  2. 已注册给 Mittal Steel Temirtau
  3. 压缩文件 d:\1.rar
  4. 路径名/注释
  5.                   尺寸   压缩率  日期   时间     属性      CRC   方法 版本
  6. -------------------------------------------------------------------------------
  7. 1\2\6.txt
  8.                      0        0   0% 12-07-14 17:12  .....A.   00000000 m0b 2.9
  9. 1\3\7\6.txt
  10.                      0        0   0% 12-07-14 17:12  .....A.   00000000 m0b 2.9
  11. 1\4.txt
  12.                      0        0   0% 12-07-14 17:12  .....A.   00000000 m0b 2.9
  13. 1\3\7
  14.                      0        0   0% 12-07-14 17:12  .D.....   00000000 m0  2.0
  15. 1\2
  16.                      0        0   0% 12-07-14 17:12  .D.....   00000000 m0  2.0
  17. 1\3
  18.                      0        0   0% 12-07-14 17:12  .D.....   00000000 m0  2.0
  19. 1
  20.                      0        0   0% 12-07-14 17:12  .D.....   00000000 m0  2.0
  21. -------------------------------------------------------------------------------
  22.     7                0        0   0%
复制代码
RAR 5.10
  1. RAR 5.10    版权所有 (C) 1993-2014 Alexander Roshal    10 六月 2014
  2. 已注册给 0
  3. 压缩文件: C:\Users\Spring\Downloads\0\第三种情况.rar
  4. 详细资料: RAR 4
  5. 属性      大小    压缩率   日期   时间   校验和  名称
  6. ----------- ---------  -------- ----- -------- -----  --------  ----
  7.     ..A....         0         0   0%  16-07-14 20:13  00000000  t\1.txt
  8.     ..A....         0         0   0%  16-07-14 20:13  00000000  t\2.txt
  9.     ..A....         0         0   0%  16-07-14 20:13  00000000  t\3.txt
  10.     ...D...         0         0   0%  16-07-14 20:14  00000000  t
  11. ----------- ---------  -------- ----- -------- -----  --------  ----
  12.                     0         0   0%                            4
复制代码

作者: zhanglei1371    时间: 2014-7-19 13:46

转载:

/* ver=1.1
;~~~~~~~~~~~~~~~~~~~~万年书妖~~~~~~~~~~~~~~~~~~~~
1、如果压缩版内只有一个文件,则是否覆盖,交给7z提问处理
2、如果有且仅有一个文件夹,解压缩;若已有同名文件夹,则新建“包内文件夹名+加后缀”的文件夹处理
3、如果有多个,以包文件夹解压缩;若已有同名文件夹,则新建“包文件名+加后缀”的文件夹处理
;~~~~~~~~~~~~~~~~~~~~万年书妖~~~~~~~~~~~~~~~~~~~~
*/

#NoTrayIcon
#NoEnv
#SingleInstance Ignore
SetWorkingDir,%A_ScriptDir%
candyselected=%1%

;━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
; 若灌入脚本,配合candy使用,删除上面的行即可
;━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
cando_智能解压:
        SmartUnZip_首层多个文件标志:=0
        SmartUnZip_首层有文件夹标志:=0
        SmartUnZip_首层文件夹名:=
        SmartUnZip_文件夹名A:=
        SmartUnZip_文件夹名B:=

        包列表=%A_Temp%\wannianshuyaozhinengjieya_%A_Now%.txt
        程序路径_7Z=Z:\Kini\File\Zip\7z\7z.exe
        程序路径_7ZG=Z:\Kini\File\Zip\7z\7zg.exe

        SplitPath ,candyselected,,包目录,,包文件名
        RunWait, %comspec% /c %程序路径_7Z% l "%candyselected%" `>"%包列表%",,hide


;━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

        loop,read,%包列表%
        {
                If(RegExMatch(A_LoopReadLine,"^(\d\d\d\d-\d\d-\d\d)"))
                {
                        If( InStr(A_loopreadline,"D")=21 Or InStr(A_loopreadline,"\"))  ;本行如果包含\或者有D标志,则判定为文件夹
                        {
                                SmartUnZip_首层有文件夹标志=1
                        }

                        If InStr(A_loopreadline,"\")
                                StringMid,SmartUnZip_文件夹名A,A_LoopReadLine,54,InStr(A_loopreadline,"\")-54
                        Else
                                StringTrimLeft,SmartUnZip_文件夹名A,A_LoopReadLine,53

                        If((SmartUnZip_文件夹名B != SmartUnZip_文件夹名A ) And ( SmartUnZip_文件夹名B!="" ))
                        {
                                SmartUnZip_首层多个文件标志=1
                                Break
                        }
                        SmartUnZip_文件夹名B:=SmartUnZip_文件夹名A
                }
        }
        FileDelete,%包列表%

;━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
        If(SmartUnZip_首层多个文件标志=0 && SmartUnZip_首层有文件夹标志=0 )   ;压缩文件内,首层有且仅有一个文件
        {
                Run, %程序路径_7ZG% x "%candyselected%" -o"%包目录%"    ;覆盖还是改名,交给7z
        }

        Else If(SmartUnZip_首层多个文件标志=0 && SmartUnZip_首层有文件夹标志=1 )   ;压缩文件内,首层有且仅有一个文件夹
        {
                IfExist,%包目录%\%SmartUnZip_文件夹名A%   ;已经存在了以“首层文件夹命名”的文件夹,怎么办?
                {
                        Loop
                        {
                                SmartUnZip_NewFolderName=%包目录%\%SmartUnZip_文件夹名A%( %A_Index% )
                                If !FileExist( SmartUnZip_NewFolderName )
                                {
                                        Run, %程序路径_7ZG% x "%candyselected%"   -o"%SmartUnZip_NewFolderName%"
                                        break
                                }
                        }
                }
                Else  ;没有“首层文件夹命名”的文件夹,那就太好了
                {
                        Run, %程序路径_7ZG% x "%candyselected%" -o"%包目录%"
                }
        }
        Else  ;压缩文件内,首层有多个文件夹
        {
                IfExist %包目录%\%包文件名%  ;已经存在了以“包文件名”的文件夹,怎么办?
                {
                        Loop
                        {
                                SmartUnZip_NewFolderName=%包目录%\%包文件名%( %A_Index% )
                                If !FileExist( SmartUnZip_NewFolderName )
                                {
                                        Run, %程序路径_7ZG% x "%candyselected%"   -o"%SmartUnZip_NewFolderName%"
                                        break
                                }
                        }
                }
                Else ;没有,那就太好了
                {
                        Run, %程序路径_7ZG% x  "%candyselected%" -o"%包目录%\%包文件名%"
                }
        }
        Return
作者: yu2n    时间: 2015-1-3 22:37

本帖最后由 yu2n 于 2015-1-3 23:18 编辑

VBS + 7-Zip(v920)
  1. Main
  2. Sub Main
  3.   ' 以命令行模式运行,可去掉(需要同时去掉WScript.Echo部分)
  4.   If InStr(1,WScript.FullName&"|","WScript.exe|",1)>0 Then
  5.     Dim oArg, sArgs
  6.     For Each oArg In WScript.Arguments
  7.       sArgs = sArgs & " """ & oArg & """"
  8.     Next
  9.     CreateObject("WScript.Shell").Run "CScript.exe //NoLogo """ & _
  10.         Wscript.ScriptFullName & """" & sArgs
  11.     WScript.Quit(0)
  12.   End If
  13.   ' 获取参数
  14.   If WScript.Arguments.Count = 0 Then
  15.     WScript.Echo vbCrLf & " --- 错误:没有参数。请拖放一个压缩文件到本程序图标上。" & _
  16.                  vbCrLf & " --- 程序将在 5 秒后退出 ... "
  17.     WScript.Sleep 5000
  18.     WScript.Quit(1)
  19.   Else
  20.     For Each arg In WScript.Arguments
  21.       Expand arg
  22.     Next
  23.     WScript.Echo vbCrLf & " --- 完成。" & _
  24.                  vbCrLf & " --- 程序将在 5 秒后退出 ... "
  25.     WScript.Sleep 5000
  26.     WScript.Quit(0)
  27.   End If
  28. End Sub
  29. ' 使用 7z.exe 智能解压压缩文件
  30. Sub Expand(solid_file)
  31.   Dim wso, fso
  32.   Set wso = CreateObject("WScript.Shell")
  33.   Set fso = CreateObject("Scripting.FileSystemObject")
  34.   ' 检测参数
  35.   If Not fso.FileExists(solid_file) Then
  36.     WScript.Echo vbCrLf & " --- 错误:仅支持文件参数。" & _
  37.                  vbCrLf & " --- 程序将在 5 秒后退出 ... "
  38.     WScript.Sleep 5000
  39.     WScript.Quit(2)
  40.   End If
  41.   ' 检查 7z.EXE 是否存在
  42.   BinPath = wso.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\7zFM.exe\path")
  43.   If Not fso.FileExists(BinPath & "\7zFM.exe") Then
  44.     WScript.Echo vbCrLf & " --- 错误:本程序依赖 7-Zip 程序,请安装 7-Zip 后执行本程序。" & _
  45.                  vbCrLf & " --- 程序将在 5 秒后退出 ... "
  46.     WScript.Sleep 5000
  47.     WScript.Quit(1)
  48.   End If
  49.   ' 执行 7z.exe 保存结果
  50.   WScript.Echo vbCrLf & " --- 正在检查压缩文件 " & vbCrLf & solid_file
  51.   wso.CurrentDirectory = wso.ExpandenVironmentStrings("%temp%")
  52.   file_log = wso.ExpandenVironmentStrings("%temp%") & "\" & fso.GetTempName
  53.   file_log = wso.ExpandenVironmentStrings("%temp%\7z-check.log")
  54.   Set oExec = wso.Exec("cmd.exe")
  55.   oExec.StdIn.WriteLine """" & BinPath & "\7z.exe""" & " l """ & solid_file & """>""" & file_log & """"
  56.   oExec.StdIn.WriteLine "exit"
  57.   errMsg = oExec.StdErr.ReadAll()
  58.   stdMsg = oExec.StdOut.ReadAll()
  59.   'WScript.Echo "errMsg:" & errMsg & "stdMsg:" & stdMsg
  60.   ' 分析文件列表,取出对应的因素
  61.   Dim oTxt, bStart, bEnd, strLine, nLine, nRootFile, nRootFolder, nFile, nFolder
  62.   nLine=0 : nRootFile=0 : nRootFolder=0 : nFile=0 : nFolder=0
  63.   Set oTxt = fso.OpenTextFile(fso.GetFile(file_log).Path, 1)
  64.   Do Until oTxt.AtEndOfStream
  65.     '逐行读取
  66.     strLine = Trim(oTxt.ReadLine())     ' 开始、结束标记(---)
  67.     If strLine = "------------------- ----- ------------ ------------  ------------------------" Then
  68.       If bStart=False Then
  69.         bStart = True
  70.       Else
  71.         bEnd = True   :  Exit Do
  72.       End If
  73.     Else
  74.       If bStart = True Then
  75.         nLine = nLine + 1
  76.         ' 分析每一个元素
  77.         If regEx_test("[\.A-Z]{5}", strLine)=True Then
  78.           ' 统计在根目录下的文件/文件夹个数
  79.           strAttr = Trim(Join(regEx_execute("[\.A-Z]{5}", strLine), ""))
  80.           If Not InStr(strLine, "\") > 0 Then
  81.             If InStr(strAttr, "A") > 0 Then nRootFile = nRootFile + 1
  82.             If InStr(strAttr, "D") > 0 Then nRootFolder = nRootFolder + 1
  83.           End If
  84.           ' 统计文件/文件夹个数
  85.           If InStr(strAttr, "A") >0 Then nFile = nFile + 1
  86.           If InStr(strAttr, "D") >0 Then nFolder = nFolder + 1
  87.           WScript.Echo "[" & nLine & "]" & vbTab & strLine
  88.         End If
  89.       End If
  90.     End If
  91.   Loop
  92.   oTxt.close  
  93.   
  94.   WScript.Echo vbCrLf & "该压缩文件含:" & nFile & " 个文件," & nFolder & " 个文件夹。" & _
  95.                vbCrLf & "该压缩文件根目录下有:" & nRootFile & " 个文件," & nRootFolder & " 个文件夹。"
  96.   
  97.   ' 判断解压位置
  98.   fn = Left(fso.GetFileName(solid_file), Len(fso.GetFileName(solid_file))-Len(fso.GetExtensionName(solid_file))-1)
  99.   fp = fso.GetFile(solid_file).ParentFolder  ' 文件所在的文件夹路径
  100.   ' 根目录下只有一个文件或文件夹时直接解压,其他情况建立文件夹后解压。
  101.   If nRootFile + nRootFolder <= 1 Then
  102.     WScript.Echo vbCrLf & " --- 执行1:直接解压 ... "
  103.   ElseIf (nRootFile > 1) Or (nRootFile + nRootFolder > 1) Then
  104.     WScript.Echo vbCrLf & " --- 执行2:解压到文件夹 ... "
  105.     fp = fp & "\" & fn
  106.   Else
  107.     WScript.Echo vbCrLf & " --- 执行2:解压到文件夹 ..."
  108.     fp = fp & "\" & fn
  109.   End If
  110.   
  111.   ' 执行解压
  112.   wso.Run """" & BinPath & "\7zG.exe"" x """ & solid_file & """ -o""" & fp & """", 1, True
  113.   
  114.   Set fso = Nothing
  115.   Set wso = Nothing
  116. End Sub
  117. ' 取得正则表达式搜索结果,返回数组
  118. Function regEx_execute(ByVal sPattern, ByVal str)
  119.   Dim objItem, arrMatchs(), i : i = -1
  120.   With CreateObject("VBScript.RegExp")
  121.     .Pattern=sPattern :  .IgnoreCase=True
  122.     .Global=True      : .MultiLine=True
  123.     For Each objItem In .Execute(str)
  124.       If Not objItem.Value = "" Then
  125.         i=i+1         :  ReDim Preserve arrMatchs(i)
  126.         arrMatchs(i) = objItem.Value
  127.       End If
  128.     Next
  129.   End With
  130.   regEx_execute = arrMatchs
  131. End Function
  132. ' 正则表达式测试
  133. Function regEx_test(ByVal sPattern, ByVal str)
  134.   With CreateObject("VBScript.RegExp")
  135.     .Pattern=sPattern :  .IgnoreCase=True
  136.     .Global=True      :  .MultiLine=True
  137.     regEx_test = .Test(str)
  138.   End With
  139. End Function
复制代码
用着 7-Zip 多 Happy ...




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2