本帖最后由 yu2n 于 2015-1-4 01:14 编辑
回复 7# zhanglei1371
首先，抱歉来晚了。因为我又换了个语文老师重新学习了中华民族语言文化~~~
尝试着理解了一下：
条件1. 压缩包里面只有有一个文件，或只有一个文件夹
解决1. 直接解压
条件2. 在条件1之外的情况
解决2. 解压到以该压缩文件命名的文件夹
代码我贴在下面，如果有其他条件你可以自己改，写的够详细了……
VBS + WinRAR 3.7- Main
- Sub Main
- ' 以命令行模式运行，可去掉(需要同时去掉WScript.Echo部分)
- If InStr(1,WScript.FullName&"|","WScript.exe|",1)>0 Then
- Dim i, sArgs
- For i = 1 To WScript.Arguments.Count
- sArgs = sArgs & " " & Chr(34) & WScript.Arguments(i-1) & Chr(34)
- Next
- CreateObject("WScript.Shell").Run("CScript.exe " & Chr(34) & Wscript.ScriptFullName & Chr(34) & sArgs),3
- WScript.Quit(0)
- End If
- ' 获取参数
- If WScript.Arguments.Count = 0 Then
- WScript.Echo "提示：没有参数。"
- WScript.Quit(1)
- Else
- For Each arg In WScript.Arguments
- Check arg
- Next
- WScript.Quit(0)
- End If
- End Sub
-
- ' 检查RAR文件，执行相应操作
- Sub Check(file_rar)
-
- Set wso = CreateObject("WScript.Shell")
- Set fso = CreateObject("Scripting.FileSystemObject")
-
- ' 检测参数
- If Not fso.FileExists(file_rar) Then
- WScript.Echo "提示：参数不正确。"
- WScript.Quit(2)
- End If
-
- ' 检查 RAR.EXE 是否存在
- RAR_EXE = wso.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\WinRAR.exe\path") & "\rar.exe"
- RAR_EXE = fso.getFile(RAR_EXE).ShortPath
- If Not fso.FileExists(RAR_EXE) Then
- WScript.Echo "提示：没有找到 RAR.exe，将退出程序。"
- End If
-
- ' 获取临时文件位置，以便于保存列表
- wso.CurrentDirectory = wso.ExpandenVironmentStrings("%temp%")
- file_log = wso.ExpandenVironmentStrings("%temp%") & "\" & fso.GetTempName
- Set oExec = wso.Exec("cmd.exe")
- oExec.StdIn.WriteLine RAR_EXE & " v """ & file_rar & """>""" & file_log & """"
- oExec.StdIn.WriteLine "exit"
- errMsg = oExec.StdErr.ReadAll()
- stdMsg = oExec.StdOut.ReadAll()
- 'WScript.Echo "errMsg:" & errMsg & "stdMsg:" & stdMsg
-
- ' 分析文件列表，取出对应的因素
- Dim bStart, bEnd, strLine, arrLog()
- ReDim Preserve arrLog(1,1)
- Set rTxt = fso.OpenTextFile(fso.GetFile(file_log).Path, 1)
- Do Until rTxt.AtEndOfStream
- '逐行读取
- strLine = Trim(rTxt.ReadLine())
- If strLine=String(79,"-") Then ' 开始、结束标记
- If bStart=False Then
- bStart = True
- nLine = 0
- Else
- bEnd = True
- Exit Do
- End If
- Else
- If bStart=True Then
- nSplit = Fix(nLine/2)
- ReDim Preserve arrLog(1, nSplit)
- nLine = nLine + 1
- If nLine Mod 2 <> 0 Then
- ' 文件路径
- WScript.Echo nLine & " Path: " & Trim(strLine)
- arrLog(0, nSplit) = Trim(strLine)
- ElseIf regEx_test("[\.A-Z]{7}", strLine)=True Then
- ' 属性
- WScript.Echo nLine & " Attr: " & Trim(Join(regEx_execute("[\.A-Z]{7}", strLine), ""))
- arrLog(1, nSplit) = Trim(Join(regEx_execute("[\.A-Z]{7}", strLine), ""))
- End If
- End If
- End If
- Loop
- rTxt.close
-
- ' 分析每一个因素
- Dim i, nRoot, nFile, nFolder
- nRoot = 0
- nFile = 0
- nFolder = 0
- For i = 0 To UBound(arrLog, 2)
- ' 统计文件夹个数
- If InStr(arrLog(1, i), "D") >0 Then nFolder = nFolder + 1
- ' 统计文件个数
- If InStr(arrLog(1, i), "A") >0 Then nFile = nFile + 1
- ' 统计在根目录下的文件或文件夹个数
- If Not InStr(arrLog(0, i), "\") >0 Then nRoot = nRoot + 1
- Next
-
- WScript.Echo "该压缩文件含：" & nFolder & "个文件夹，" & nFile & "个文件。"
- WScript.Echo "该压缩文件根目录下有" & nRoot & "个文件、或文件夹。"
-
- If nRoot = 1 Then
- WScript.Echo "执行1：RAR 直接解压……"
- Msgbox "执行1：RAR 直接解压……"
- fp = fso.GetFile(file_rar).ParentFolder ' 文件所在的文件夹路径
- If Right(fp,1)<>"\" Then fp = fp & "\"
- wso.Run """" & RAR_EXE & """ x -r -y """ & file_rar & """ """ & fp & """"
- Else
- WScript.Echo "执行2：RAR 解压到文件夹……"
- Msgbox "执行2：RAR 解压到文件夹……"
- fp = fso.GetFile(file_rar).ParentFolder
- If Right(fp,1)<>"\" Then fp = fp & "\"
- fp = fp & Left(fso.GetFileName(file_rar), Len(fso.GetFileName(file_rar))-Len(fso.GetExtensionName(file_rar))-1)
- If Right(fp,1)<>"\" Then fp = fp & "\"
- wso.Run """" & RAR_EXE & """ x -r -y """ & file_rar & """ """ & fp & """"
- End If
- End Sub
-
- ' 取得正则表达式搜索结果，返回数组
- Function regEx_execute(ByVal sPattern, ByVal str)
- Dim regEx, Match, Matches, arrMatchs(), i : i = -1 ' 建立变量。
- Set regEx = CreateObject("VBScript.RegExp") ' 建立正则表达式。
- regEx.Pattern = sPattern ' 设置模式。
- regEx.IgnoreCase = True ' 设置是否区分字符大小写。
- regEx.Global = True ' 设置全局可用性。
- regEx.MultiLine = True ' 多行匹配模式
- Set Matches = regEx.Execute(str) ' 执行搜索。
- For Each Match in Matches ' 遍历匹配集合。
- If Not Match.Value = "" Then
- i = i + 1
- ReDim Preserve arrMatchs(i) ' 动态数组：数组随循环而变化
- arrMatchs(i) = Match.Value
- End If
- Next
- regEx_execute = arrMatchs
- Set Match = Nothing
- Set regEx = Nothing
- End Function
-
- ' 正则表达式测试
- Function regEx_test(ByVal sPattern, ByVal str)
- Dim regEx, Match, Matches ' 建立变量。
- Set regEx = CreateObject("VBScript.RegExp") ' 建立正则表达式。
- regEx.Pattern = sPattern ' 设置模式。
- regEx.IgnoreCase = True ' 设置是否区分字符大小写。
- regEx.Global = True ' 设置全局可用性。
- regEx.MultiLine = True ' 多行匹配模式
- regEx_test = regEx.Test(str)
- Set regEx = Nothing
- End Function
| 
发表于 2014-7-12 08:31
| 
发表于 2014-7-12 21:17
| 
混乱。