Edited at

今更7-zipのコマンドラインのVBScript

毎回悩むので一応作りました。

7zipのvbsはいろいろパターンがありすぎて混乱するので、自分流を作っておきます。

とりあえず

ファイルをドラッグアンドドロップすると、そのファイル名のパスワードつきzipを元あったファイルのフォルダに作成するというパターンです。

また、圧縮するファイルを一つ一つ明示します。

msgbox objFile.Name がそれです。

いらないときは削除してください。

 例えば、c:\test\hoge.txt をc:\test\hoge.zipにします

 ただし拡張子ini,dbなどのシステムファイル、accdbのアクセスファイルを除外します。またフルパスが260字以上、使ってはいけない拡張子を除外します。

 さらに丸付き数字、全角アポストロフを置換したファイル名にします。

 もちろんこれは十分ではありませんが。

正規表現は http://dobon.net/vb/dotnet/file/invalidpathchars.html

を参考にしました。

 なお、テストを兼ねてファイル名に凶子が含まれれば、京固に変換します。その前の全角アポストロフを半角アンダーバーに変えているところがわかりにくいので視認性を確保しています。それと機種依存文字の変換はそれ自体の実験が危険な面もあるためです。

なお、パスワードは-pPassword で決まっています。testにしたければ

-ptest にします。かならず後ろに半角スペースをいれてください

 それにしてもパスワードつきzipを作るのに人生にはなんと障害の多いことでしょうか。

これにさらに、

 260字以上の短縮

 日付の保持機能

 などを付け加えないと完全ではないのです。非常に圧縮は奥深いものがあります。

※objWsh.Run は同期処理が良いとのことでTrueに変えました。

http://winofsql.jp/VA003334/infoboard.php?mid=vbsguide&id=051215192026&pid=1


7zP.vbs、


Option Explicit
Dim objArgs, I , strFile, strFolder
Dim objFile, objFolder,objPath,strScr
Dim strBase,strExt,strParent,strPath,strZip,RetVal
Dim objShell : Set objShell = Createobject("WScript.Shell")
Dim FSO : Set FSO = Createobject("Scripting.FileSystemObject")
Const cnsPassWord = "Password" '2019/01/08追加
Set objArgs = Wscript.Arguments
For I = 0 to objArgs.Count-1
set objFile = FSO.GetFile(cstr(objArgs(I)))
strParent = FSO.GetParentFolderName(objFile)
set objPath = FSO.GetFolder(strParent)
strBase = FSO.GetBaseName(cstr(objArgs(I)))
strExt = FSO.GetExtensionName(cstr(objArgs(I)))
msgbox objFile.Name ' Delete?
if fnblExtCheck(strExt) = False then
If len(objFile.Path & "\" & objFile.Name) < 260 Then
If strExt <> "db" or strExt <> "ini" or strExt <> "accdb" then 'Exclude System File or Access file
strPath = strParent & "\"
'strZip = strPath & fnstr(strBase) & ".zip" 'Set Zip File Name 'Already File then Do Nothing
strZip = strPath & fnstr(strBase) & "_" & strExt & ".zip" 'Set Zip File Name 'Already File then Do Nothing
if FSO.FileExists(strZip) = False then
'strScr = """%ProgramFiles%" & "\7-zip\7z.exe "" a -pPassword " & chr(34) & strZip & chr(34) & " " & chr(34) & strPath & objFile.Name & chr(34)
strScr = """%ProgramFiles%" & "\7-zip\7z.exe "" a -p" & cnsPassWord & " " & chr(34) & strZip & chr(34) & " " & chr(34) & strPath & objFile.Name & chr(34)
RetVal = objShell.Run(strScr,0,True)
End if
End if
End If
End If
Next
set objShell = Nothing
set FSO = Nothing
Wscript.Quit

Function fnStr(strBase)
Dim A1,B1,i,buf
A1=Split("①,②,③,④,’,',凶子",",")
B1=Split("1,2,3,4,_,_,京固",",")
buf=""
buf=strBase
for i= LBound(a1) to UBound(a1)
buf = Replace(buf,cstr(a1(i)),cstr(b1(i)),1,-1)
Next
fnstr=buf
End Function

Function fnblExtCheck(strExt)
Dim Re : Set Re = New RegExp
With Re
.Pattern = "^(CON|PRN|AUX|NUL|COM[0-9]|LPT[0-9]|CLOCK\$)"
.Ignorecase = True
if .test(strExt) = true then
fnblExtCheck = true
Else
fnblExtCheck = False
End If
End With
set Re = Nothing
End Function



VBS/VBScriptで7zipで解凍する場合

ファイル単位で圧縮されている場合のzipファイルを解凍します。

注意:

このVBScriptはファイルを圧縮しているzipファイルを前提としています。フォルダではありません。

7z.exeの場所は以下のところを前提にしています。上記の圧縮ファイルも同様です。

"C:\Program Files\7-Zip\7z.exe"

zipファイルをドラッグアンドドロップすることによってzipファイルのある場所に解凍します。同名のファイルがあれば確認なしで上書きします。同名のファイルがあれば解凍してほしくない場合には-aoaを-aosに変えてください。


ExtractWith7zip.vbs

Option Explicit

Dim objArgs, I , strFile, strFolder
Dim objFile, objFolder,objPath,strScr
Dim strBase,strExt,strParent,strPath,strZip,RetVal
Dim objWSH : Set objWSH = CreateObject("WScript.Shell")
Dim FSO : Set FSO = Createobject("Scripting.FileSystemObject")
Const cnsPassWord = "Password"
Set objArgs = WScript.Arguments
For I = 0 to objArgs.Count-1
With FSO
IF .fileexists(.GetFile(cstr(objArgs(I)))) Then
set objFile = .GetFile(cstr(objArgs(I)))
strParent = .GetParentFolderName(objFile)
set objPath = .GetFolder(strParent)
strBase = .GetBaseName(cstr(objArgs(I)))
strExt = .GetExtensionName(cstr(objArgs(I)))
'msgbox objFile.Name ' Delete?
If strExt = "zip" then
strScr = """%ProgramFiles%" & "\7-zip\7z.exe "" x -y -p" & cnsPassWord & " " & chr(34) & objFile.Path & chr(34) & " -o" & chr(34) & strParent & chr(34) & " -aoa"
'WScript.echo strScr
RetVal = objWSH.Run(strScr,0,True)
If Retval <> 0 then
MsgBox "RetVal = " & RetVal & " Error occur End " & vbCrlf & _
"FileName :" & objFile.Path & vbCrlf & _
"CommandString :" & strScr & vbCrlf & _
"1 Warning (Non fatal error(s)). For example, one or more files were locked by some other application, so they were not compressed. " & vbCrlf & _
"2 Fatal error " & vbCrlf & _
"7 Command line error " & vbCrlf & _
"8 Not enough memory for operation " & vbCrlf & _
"255 User stopped the process "
Wscript.Quit
End If
End If
End If
End With
Next
set objWSH = Nothing
set FSO = Nothing
Wscript.Echo "Finish: RetVal =" & RetVal & vbCrLf & " 0 means Success"
Wscript.Quit


変更

2019/01/08

Passwordを定数化

Zipのファイル名に拡張子がついていなかったので追加。