7-ZipのEXEをコマンドライン操作して、パスワード保護ZIPを自動生成するスクリプト
コード
Option Explicit
Const PASSWORD_LENGTH = 8
Const ZIPEXE_PATH = """C:\Program Files\7-Zip\7z.exe"""
Dim fFS
Set fFS = Nothing
Function CreatePasswrodSource(ByRef aSource, ByRef aReading)
Dim aDigitC, aDigitR
aDigitC = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
aDigitR = Array("０", "１", "２", "３", "４", "５", "６", "７", "８", "９")
Dim aLCaseC, aLCaseR
aLCaseC = Array( _
"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", _
"k", "l", "m", "n", "o", "p", "q", "r", "s", "t", _
"u", "v", "w", "x", "y", "z")
aLCaseR = Array( _
"エー", "ビー", "シー", "ディー", "イー", "エフ", "ジー", "エイチ", "アイ", "ジェイ", _
"ケー", "エル", "エム", "エヌ", "オー", "ピー", "キュー", "アール", "エス", "ティー", _
"ユー", "ヴイ", "ダブリュー", "エックス", "ワイ", "ゼット")
Dim aUCaseC, aUCaseR
aUCaseC = Array( _
"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", _
"K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", _
"U", "V", "W", "X", "Y", "Z")
aUCaseR = Array( _
"エー", "ビー", "シー", "ディー", "イー", "エフ", "ジー", "エイチ", "アイ", "ジェイ", _
"ケー", "エル", "エム", "エヌ", "オー", "ピー", "キュー", "アール", "エス", "ティー", _
"ユー", "ヴイ", "ダブリュー", "エックス", "ワイ", "ゼット")
Dim aSymbolC, aSymbolR
aSymbolC = Array( _
"`", "~", "!", "@", "#", _
"$", "%", "^", "&", "*", _
"(", ")", "_", "-", "+", _
"=", "{", "}", "[", "]", _
"\", "|", ":", ";", """", _
"'", "<", ">", ",", ".", _
"?", "/")
aSymbolR = Array( _
"バッククォート", "チルダ", "感嘆符", "アットマーク", "シャープ", _
"ドル記号", "パーセント", "ハット", "アンパサンド", "アスタリスク", _
"左括弧", "右括弧", "アンダースコア", "ハイフン", "プラス", _
"イコール", "左中括弧", "右中括弧", "左大括弧", "右大括弧", _
"円記号", "パイプ", "コロン", "セミコロン", "ダブルクォート", _
"シングルクォート", "小なり", "大なり", "カンマ", "ピリオド", _
"疑問符", "スラッシュ")
Dim vLength
vLength = 9*(UBound(aDigitC) + 1) + 3*(UBound(aLCaseC) + 1) + 3*(UBound(aUCaseC) + 1)
ReDim aSource(vLength)
ReDim aReading(vLength)
Dim vI, vJ, vPos
vPos = 0
For vJ = 1 To 9 Step 1
For vI = 0 To UBound(aDigitC) Step 1
aSource(vPos + vI) = aDigitC(vI)
aReading(vPos + vI) = aDigitR(vI)
Next 'vI
vPos = vPos + UBound(aDigitC) + 1
Next 'vJ
For vJ = 1 To 3 Step 1
For vI = 0 To UBound(aLCaseC) Step 1
aSource(vPos + vI) = aLCaseC(vI)
aReading(vPos + vI) = aLCaseR(vI)
Next 'vI
vPos = vPos + UBound(aLCaseC) + 1
Next 'vJ
For vJ= 1 To 3 Step 1
For vI = 0 To UBound(aUCaseC) Step 1
aSource(vPos + vI) = aUCaseC(vI)
aReading(vPos + vI) = aUCaseR(vI)
Next 'vI
vPos = vPos + UBound(aUCaseC) + 1
Next 'vJ
CreatePasswrodSource = True
End Function
Function CreatePassword(ByRef rPassword, ByRef rReading, ByRef aSource, ByRef aReading, pLength, pDelimiter)
If ((UBound(aSource) < 0) Or (UBound(aReading) < 0) Or (pLength < 6) Or Len(pDelimiter) = 0) Then
CreatePassword = False
Exit Function
End If
Call Randomize
Dim vI, v, vSourceSize
vSourceSize = UBound(aSource) + 1
For vI = 1 To pLength Step 1
v = Int(Rnd*vSourceSize) '0～(vSourceSize - 1)の整数乱数
If (vI > 1) Then
rPassword = rPassword & aSource(v)
rReading = rReading & " " & aReading(v)
Else
rPassword = aSource(v)
rReading = aReading(v)
End If
Next 'vI
CreatePassword = True
End Function
Function IsPasswordComplex(pPassword, pLength)
Dim bDigit, bLCaseA, bUCaseA, bSymbol
bDigit = False
bLCaseA = False
bUCaseA = False
bSymbol = False
If (Len(pPassword) < pLength) Then
IsPasswordComplex = False
Exit Function
End If
Dim vI, vScore
For vI = 1 To Len(pPassword) Step 1
Dim vChar
vChar = Mid(pPassword, vI , 1)
If ((Asc("0") <= Asc(vChar)) And (Asc(vChar) <= Asc("9"))) Then
bDigit = True
ElseIf ((Asc("a") <= Asc(vChar)) And (Asc(vChar) <= Asc("z"))) Then
bLCaseA = True
ElseIf ((Asc("A") <= Asc(vChar)) And (Asc(vChar) <= Asc("Z"))) Then
bUCaseA = True
Else
bSymbol = True
End If
Next 'vI
vScore = 0
If (bDigit) Then
vScore = vScore + 1
End If
If (bLCaseA) Then
vScore = vScore + 1
End If
If (bUCaseA) Then
vScore = vScore + 1
End If
If (bSymbol) Then
vScore = vScore + 1
End If
If (vScore >= 3) Then
IsPasswordComplex = True
Else
IsPasswordComplex = False
End If
End Function
Function GetFileName(ByVal pPath)
Dim vPos, vName
vPos = InstrRev(pPath, ".")
If (vPos <> 0) Then
vName = Left(pPath, vPos - 1)
Else
vName = pPath
End If
GetFileName = vName
End Function
Function IsFilePath(ByVal pPath)
If (fFS Is Nothing) Then
Set fFS = WScript.CreateObject("Scripting.FileSystemObject")
End If
If (Len(pPath) > 0) Then
IsFilePath = fFS.FileExists(pPath)
Else
IsFilePath = False
End If
End Function
Function IsFileExists(ByVal pPath)
If (fFS Is Nothing) Then
Set fFS = WScript.CreateObject("Scripting.FileSystemObject")
End If
If (Len(pPath) > 0) Then
IsFileExists = fFS.FileExists(pPath)
Else
IsFileExists = False
End If
End Function
Function GetCommandLine(rCmdLine, rZipPath, rTxtPath, ByVal pPath, ByVal pPassword)
If Not ((Len(pPath) > 0) And (Len(pPassword) > 0)) Then
GetCommandLine = False
Exit Function
End If
Dim vTarget
If (IsFilePath(pPath)) Then
rZipPath = GetFileName(pPath) & ".zip"
rTxtPath = GetFileName(pPath) & "-Password.txt"
vTarget = pPath
Else
rZipPath = pPath & ".zip"
rTxtPath = pPath & "-Password.txt"
vTarget = pPath & "\*"
End If
rCmdLine = ZIPEXE_PATH & " a -scsUTF-8 -ssc- -tzip -mx9 -r -p" & pPassword & " """ & rZipPath & """ """ & vTarget & """"
GetCommandLine = True
End Function
Function ExecuteCommandLine(ByVal pCmdLIne)
Dim oWSH
Set oWSH = WScript.CreateObject("WScript.Shell")
ExecuteCommandLine = oWSH.Run(pCmdLIne, 0, True)
Set oWSH = Nothing
End Function
Sub OutputPasswordToFile(ByVal pPath, ByVal pPassword, ByVal pReading)
If (fFS Is Nothing) Then
Set fFS = WScript.CreateObject("Scripting.FileSystemObject")
End If
Dim oTxtFile, vMessage
Set oTxtFile = fFS.CreateTextFile(pPath, False, True)
vMessage = "パスワードは " & pPassword & " です。" & vbCrLf & _
"(" & pReading & ") - " & Len(pPassword) & "文字"
Call oTxtFile.WriteLine(vMessage)
Call oTxtFile.Close
Set oTxtFile = Nothing
End Sub
'////////////////////////////////////////////////////////////////////////////////
If (WScript.Arguments.Count = 0) Then
Call WScript.Echo("ファイルパス・フォルダパスを" & vbCrLf & "指定するかドロップしてください。")
Call WScript.Quit(1)
End If
' パスワードソースの生成
Dim bResult, aSource(), aReading()
bResult = CreatePasswrodSource(aSource, aReading)
' 複雑なパスワードの生成
Dim vPassword, vReading
bResult = CreatePassword(vPassword, vReading, aSource, aReading, PASSWORD_LENGTH, " ")
bResult = IsPasswordComplex(vPassword, PASSWORD_LENGTH)
Do Until (bResult)
bResult = CreatePassword(vPassword, vReading, aSource, aReading, PASSWORD_LENGTH, " ")
bResult = IsPasswordComplex(vPassword, PASSWORD_LENGTH)
Loop
' コマンドライン文字列の生成
Dim vCmdLine, vZipPath, vTxtPath
bResult = GetCommandLine(vCmdLine, vZipPath, vTxtPath, WScript.Arguments.Item(0), vPassword)
If (Not bResult) Then
Call WScript.Echo("アーカイヴコマンドラインの" & vbCrLf & "作成に失敗しました。")
Call WScript.Quit(1)
End If
' 出力ファイルのチェック
If (IsFileExists(vZipPath)) Then
Call WScript.Echo("""" & vZipPath & """" & vbCrLf & "は既に存在します。")
Call WScript.Quit(1)
End If
If (IsFileExists(vTxtPath)) Then
Call WScript.Echo("""" & vTxtPath & """" & vbCrLf & "は既に存在します。")
Call WScript.Quit(1)
End If
' アーカイヴコマンドの実行
If (Not ExecuteCommandLine(vCmdLine) = 0) Then
Call WScript.Echo("アーカイヴコマンドラインの実行に失敗しました。")
Call WScript.Quit(1)
End If
Call OutputPasswordToFile(vTxtPath, vPassword, vReading)
Set fFS = Nothing
最終更新：2010年02月07日 00:39
