基于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的智能解壓腳本
'主要解決 “解壓到文件夾”導致的文件夾套文件夾 和 “解壓縮到當前文件夾”導致的文件混亂矛盾
'發(fā)現(xiàn) 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")
'---------------------------------------------------------------------
'幫助與右鍵菜單關聯(lián)，可按需添加
'---------------------------------------------------------------------
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 '頂層文件或文件夾數(shù)量
Num_Folder = 0 '子文件夾中文件數(shù)量
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
'------------------------------------------------------------------------
'右鍵菜單管理函數(shù)
'------------------------------------------------------------------------
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
