| Main |
| Sub Main |
| |
| 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 |
| |
| |
| 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 = 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() |
| |
| |
| |
| 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 FunctionCOPY |
发表于 2014-7-12 08:31
| 
发表于 2014-7-12 11:15
| 
混乱。
