VBAでパスワード生成クラスを作ってみた。

# はじめに

ユーザ登録とかを省力化するためにパスワード生成用クラスを作ってみた。

# 作成環境

- Windows10 22H2
- Microsoft Office 365 Excel (Ver.2303) 

# つかいかた

- VBEを開き、[ツール] - [参照設定]で
`Microsoft Scripting Runtime` にチェックを入れる。
- 下記ソースを`PasswordClass.cls`として保存し、VBEにインポートする

# プロパティ、メソッド、定数

|種類|名前|説明|
|:---:|:---:|:---:|
|定数|CtNumeric|パスワード文字種指定用。数字|
|定数|CtLCase|パスワード文字種指定用。英小文字|
|定数|CtUCase|パスワード文字種指定用。英大文字|
|定数|CtSymbol|パスワード文字種指定用。記号|
|プロパティ|NumericStr|数字候補文字列取得・設定|
|プロパティ|LCaseStr|英小文字候補文字列取得・設定|
|プロパティ|UCaseStr|英大文字候補文字列取得・設定|
|プロパティ|SymbolStr|記号候補文字列取得・設定|
|メソッド|Generate(<文字種指定>,<パスワードの長さ>,<文字使用回数>)|パスワードを作成し、文字列で返す|

# 使用例

```vb
With New PasswordClass
    MsgBox .Generate(CtNumeric + CtLCase, 8, 1)
End With
```

# ソース

```vb:PasswordClass.cls
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "PasswordClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' パスワードに使用する文字のデフォルト値
Private Const cDefaultNumeric   As String = "0123456789"
Private Const cDefaultLCase     As String = "abcdefghijklmnopqrstuvwxyz"
Private Const cDefaultUCase     As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Private Const cDefaultSymbol    As String = "!#$%&-=?+*:@"

' パスワードに使用する文字を格納する配列
Private Chrs(0 To 3)            As String

' 文字種指定列挙体
Public Enum pwChrType
    CtNumeric = 1
    CtLCase = 2
    CtUCase = 4
    CtSymbol = 8
End Enum

' 文字種配列のインデックス列挙体
Private Enum pwTypeIdx
    IdNumeric = 0
    IdLCase = 1
    IdUCase = 2
    IdSymbol = 3
End Enum

' コンストラクタ
Private Sub Class_Initialize()
    Chrs(IdNumeric) = cDefaultNumeric
    Chrs(IdLCase) = cDefaultLCase
    Chrs(IdUCase) = cDefaultUCase
    Chrs(IdSymbol) = cDefaultSymbol
    Randomize
End Sub

' １～指定値までの乱数を返す
Private Function Rand(llMax As Long) As Long
    Rand = Int(Rnd * llMax) + 1
End Function

' パスワード生成
' leType        使用する文字種を指定（+でつなげることで複数指定可）
' llLength      生成するパスワードの長さ
' llTimes       文字ごとの最大使用回数
Public Function Generate(leType As pwChrType, llLength As Long, llTimes As Long) As String
    Dim i               As Long             ' ループカウンタ
    Dim j               As Long             ' ループカウンタ
    Dim r               As Long             ' 乱数値保持用
    Dim lsPass          As String           ' パスワード文字列
    Dim lcTypes         As New Collection   ' 文字種リストコレクション
    Dim lcType          As Collection       ' 選択文字種リスト参照用
    Dim lcChrs          As Collection       ' 文字リストコレクション
    Dim ldChr           As Dictionary       ' 文字リストメンバ用ディクショナリ
    Dim lcIdx           As New Collection   ' 文字種初期位置インデックスリスト
    Dim lvPlace         As Variant          ' 文字種初期位置保持用配列

    lsPass = ""
    ' leTypeの値を元に文字種リストのコレクションを作成
    For i = 0 To 3
        If (2 ^ i And leType) > 0 Then
            Set lcChrs = New Collection
            For j = 1 To Len(Chrs(i))
                Set ldChr = New Dictionary
                ldChr.Add "char", Mid(Chrs(i), j, 1)
                ldChr.Add "times", llTimes
                lcChrs.Add ldChr
            Next
            lcTypes.Add lcChrs
        End If
    Next
    ' 文字種リストが空でない場合だけ処理
    If lcTypes.Count > 0 Then
        ' 文字種初期位置決定用リストを作成
        ReDim lvPlace(1 To llLength)
        For i = 1 To llLength
            lcIdx.Add i
            lvPlace(i) = 0
        Next
        ' 各文字種の初期位置を決定
        For i = 1 To lcTypes.Count
            ' 文字種のインデックスを位置候補からランダムに選択し代入
            r = Rand(lcIdx.Count)
            lvPlace(lcIdx(r)) = i
            ' 使用した位置候補をリストから削除
            lcIdx.Remove r
        Next
        ' パスワード作成処理
        For i = 1 To llLength
            ' 文字種指定があればその文字種に、そうでなければランダム
            If lvPlace(i) > 0 Then
                Set lcType = lcTypes(lvPlace(i))
            Else
                Set lcType = lcTypes(Rand(lcTypes.Count))
            End If
            ' パスワード文字追加
            r = Rand(lcType.Count)
            Set ldChr = lcType(r)
            lsPass = lsPass & ldChr("char")
            ' 文字ごとの使用回数を超えたら候補リストから削除
            ldChr("times") = ldChr("times") - 1
            If ldChr("times") <= 0 Then lcType.Remove r
        Next
    End If
    ' あとしまつ
    Set lcTypes = Nothing
    Set lcType = Nothing
    Set lcIdx = Nothing
    Set lcChrs = Nothing
    Set ldChr = Nothing
    Generate = lsPass
End Function

' パスワード文字種の数字を取得
Public Property Get NumericStr() As String
    NumericStr = Chrs(IdNumeric)
End Property

' パスワード文字種の数字を設定
Public Property Let NumericStr(lsStr As String)
    Chrs(IdNumeric) = lsStr
End Property

' パスワード文字種のアルファベット小文字を取得
Public Property Get LCaseStr() As String
    LCaseStr = Chrs(IdLCase)
End Property

' パスワード文字種のアルファベット小文字を設定
Public Property Let LCaseStr(lsStr As String)
    Chrs(IdLCase) = lsStr
End Property

' パスワード文字種のアルファベット大文字を取得
Public Property Get UCaseStr() As String
    UCaseStr = Chrs(IdUCase)
End Property

' パスワード文字種のアルファベット大文字を設定
Public Property Let UCaseStr(lsStr As String)
    Chrs(IdUCase) = lsStr
End Property

' パスワード文字種の記号を取得
Public Property Get SymbolStr() As String
    SymbolStr = Chrs(IdSymbol)
End Property

' パスワード文字種の記号を設定
Public Property Let SymbolStr(lsStr As String)
    Chrs(IdSymbol) = lsStr
End Property

```