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(<文字種指定>,<パスワードの長さ>,<文字使用回数>)	パスワードを作成し、文字列で返す

使用例

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

ソース

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