|
基于7z的智能解压脚本
顺便演示了一下如何用 vbs 操纵注册表右键菜单
放到7z文件夹运行即可
也可以用 sendto菜单、hoekey热键之类调用
可以到网盘下载带7z的懒人包：
http://pan.baidu.com/share/link?shareid=1605&uk=1426753336
Smart7zX.vbs 基于7z的智能解压
'------------------------------------------------------------------------------------
'Smart7zX.vbs Ver 1.2
'基于7z的智能解压脚本
'主要解决 “解压到文件夹”导致的文件夹套文件夹 和 “解压缩到当前文件夹”导致的文件混乱矛盾
'发现 7z 的重复文件处理还蛮对口味的，就懒得自己搞了
'整个代码很简单，有需要的自己改
'详细介绍见作者主页 http://hi.baidu.com/new/hyhoekey
'------------------------------------------------------------------------------------
'On Error Resume Next
Dim WshShell, fso, backMsgBox
Set WshShell = CreateObject("WSCript.Shell")
Set fso = CreateObject("scripting.filesystemobject")
'---------------------------------------------------------------------
'帮助与右键菜单关联，可按需添加
'---------------------------------------------------------------------
If WScript.Arguments.Count = 0 Then
backMsgBox = MsgBox(vbCrLf & WScript.ScriptName & vbTab & "Smart7zX 智能解压" & vbCrLf & vbCrLf & vbCrLf _
& "Usage: " & vbTab & WScript.ScriptName & vbTab & "zipfile" & vbCrLf & vbCrLf _
& "Examples: " & vbCrLf & vbCrLf _
& WScript.ScriptName & " ABC.zip" & vbCrLf & vbCrLf _
& WScript.ScriptName & " XYZ.rar" & vbCrLf & vbCrLf _
& WScript.ScriptName & " 123.7z" & vbCrLf & vbCrLf _
& vbCrLf & vbCrLf _
& "按【是】 在 压缩文件 右键菜单添加！" & vbCrLf & vbCrLf _
& "按【否】 从 压缩文件 右键菜单删除！" & vbCrLf & vbCrLf _
& "按【取消】 退出。" & vbCrLf & vbCrLf & vbCrLf _
& "http://hi.baidu.com/new/hyhoekey" _
, 67, WScript.ScriptName)
If backMsgBox <> vbCancel Then
RightMenuMgr("zip")
RightMenuMgr("rar")
RightMenuMgr("7z")
End If
WScript.Quit(0)
End If
'---------------------------------------------------------------------
'主脚本
'---------------------------------------------------------------------
exe_7z = Replace(WScript.ScriptFullName, WScript.ScriptName, "7z.exe")
exe_7zG = Replace(WScript.ScriptFullName, WScript.ScriptName, "7zG.exe")
File_Folder = fso.GetParentFolderName(WScript.Arguments(0))
File_BaseName = fso.GetBaseName(WScript.Arguments(0))
Set oexec = WshShell.Exec(exe_7z & " l " & Chr(34) & WScript.Arguments(0) & Chr(34))
str = oExec.StdOut.ReadAll
ss = split(str, "------------------- ----- ------------ ------------ ------------------------" & vbCrLf, -1, 1)
strLine = split(ss(1), vbCrLf, -1, 1)
'WScript.Echo str
Num_Top = 0 '顶层文件或文件夹数量
Num_Folder = 0 '子文件夹中文件数量
Name_Folder = 0 '从 子文件夹中文件 获取的 顶层文件夹名字
Name_TopFolder = 0 '7z获取的 D属性顶层文件夹名字
Folder_equal = 0 '
Unzip_Current = 0 '
For i = 0 To (UBound(strLine) - 1)
If InStr(strLine(i), "\") = 0 Then
Num_Top = Num_Top + 1
If Mid(strLine(i), 21, 1) = "D" Then Name_TopFolder = Right(strLine(i), Len(strLine(i)) - 53)
Else
Num_Folder = Num_Folder + 1
Name_Folder = Mid(strLine(i), 54, InStr(strLine(i), "\") - 54)
End If
Next
If UBound(strLine) = 1 Then Unzip_Current = 1
If Len(ss(1)) - Len(Replace(ss(1), " " & Name_Folder & "\", "", 1, -1, 1)) = Len(" " & Name_Folder & "\") * Num_Folder Then Folder_equal = 1
If Folder_equal Then
If Num_Top = 0 Then Unzip_Current = 1
If Num_Top = 1 And Name_Folder = Name_TopFolder Then Unzip_Current = 1
End If
If Unzip_Current = 1 Then
WshShell.run exe_7zG & " x " & Chr(34) & WScript.Arguments(0) & Chr(34) & " -o" & Chr(34) & File_Folder & Chr(34)
Else
WshShell.run exe_7zG & " x " & Chr(34) & WScript.Arguments(0) & Chr(34) & " -o" & Chr(34) & File_Folder & "\" & File_BaseName & Chr(34)
End If
'------------------------------------------------------------------------
'右键菜单管理函数
'------------------------------------------------------------------------
Sub RightMenuMgr(ExtName)
Dim RegFileKey
RegFileKey = "HKCR\" & WshShell.RegRead("HKCR\." & ExtName & "\")
Select Case backMsgBox
Case vbYes
WshShell.RegWrite RegFileKey & "\shell\Smart7zX\", "Smart7zX 智能解压(&7)"
WshShell.RegWrite RegFileKey & "\shell\Smart7zX\command\", "WScript.exe " & """" & WScript.ScriptFullName & """" & " " & """" & "%1" & """"
Case vbNo
WshShell.RegDelete RegFileKey & "\shell\Smart7zX\command\"
WshShell.RegDelete RegFileKey & "\shell\Smart7zX\"
Case Else
End Select
End Sub
|
