Task: Password generator








VB: Option Explicit
Sub Main()
Dim s() As String, i As Long
        Debug.Print "list of 10 passwords : "

    s = Gp(10, 21, False)
        
        Debug.Print "1- with password
        For i = 1 To UBound(s): Debug.Print s(i): Next

    s = Gp(10, "A/9-a/1-9/4-!/5", True)
        
        Debug.Print "2- with pattern = ""A/9-a/1-9/4-!/5"" and visually similar = True :"
        For i = 1 To UBound(s): Debug.Print s(i): Next
End Sub
Sub HelpMe()
Dim s As String
    s = "Help :" & vbCrLf
    s = s & "----------------------------------" & vbCrLf
    s = s & "The function (named : Gp) needs 3 required parameters :" & vbCrLf & vbCrLf
    s = s & "1- Nb_Passwords (Long) : the number of passwords to generate." & vbCrLf & vbCrLf
    s = s & "2- NbChar_Or_Pattern (Variant) : either a number or a pattern" & vbCrLf
    s = s & "      If number : NbChar_Or_Pattern specify the password length. All the digits are random ASCII characters" & vbCrLf
    s = s & "      If pattern : NbChar_Or_Pattern specify the password length and the layout of passwords." & vbCrLf
    s = s & "             The pattern is built like this :" & vbCrLf
    s = s & "                 ""A"" means Upper case, ""a"" means lower case, 9 means numerics and ! means others characters." & vbCrLf
    s = s & "                 ""-"" is the separator between these values." & vbCrLf
    s = s & "                 the number of characters is specified after the sign (required): ""/""" & vbCrLf
    s = s & "                 example of pattern available : ""A/3-a/2-9/1-!/1""" & vbCrLf & vbCrLf
    s = s & "3- Excl_Similar_Chars (Boolean) : True if you want the option of excluding visually similar characters."
    Debug.Print s
End Sub
Private Function Gp(Nb_Passwords As Long, NbChar_Or_Pattern As Variant, Excl_Similar_Chars As Boolean) As String()

Dim l As Long, s() As String
    ReDim s(1 To Nb_Passwords)
    If IsNumeric(NbChar_Or_Pattern) Then
        For l = 1 To Nb_Passwords
            s(l) = p(CLng(NbChar_Or_Pattern), Excl_Similar_Chars)
        Next l
    Else
        For l = 1 To Nb_Passwords
            s(l) = ttt(CStr(NbChar_Or_Pattern), Excl_Similar_Chars)
        Next l
    End If
    Gp = s
End Function
Public Function p(n As Long, e As Boolean) As String

Dim t As String, i As Long, a As Boolean, b As Boolean, c As Boolean, d As Boolean
    Randomize Timer
    If n < 4 Then
        p = "Error. Numbers of characters is too small. Min : 4"
    ElseIf n >= 4 And n < 7 Then
        T = u(122, 97) & u(90, 65) & u(57, 48) & v
        For j = 5 To n
            i = Int((4 * Rnd) + 1)
            Select Case i
                Case 1: T = T & u(122, 97)
                Case 2: T = T & u(90, 65)
                Case 3: T = T & u(57, 48)
                Case 4: T = T & v
            End Select
        Next j
        
        p = y(T)
    Else
        Do
            i = Int((4 * Rnd) + 1)
            Select Case i
                Case 1: t = t & u(122, 97): a = True
                Case 2: t = t & u(90, 65): b = True
                Case 3: t = t & u(57, 48): c = True
                Case 4: t = t & v: d = True
            End Select
            If Len(t) >= 2 And e Then
                If x(t) Then t = Left(t, Len(t) - 1)
            End If
            If Len(t) = n Then
                If a And b And c And d Then
                    Exit Do
                Else
                    w t, a, b, c, d
                    p = p(n, e)
                End If
            ElseIf Len(t) > n Then
                w t, a, b, c, d
                p = p(n, e)
            End If
        Loop
        p = t
    End If
End Function
Public Function ttt(s As String, e As Boolean) As String

Dim a, i As Long, j As Long, st As String, Nb As Long
    a = Split(s, "-")
    For i = 0 To UBound(a)
        Select Case Left(a(i), 1)
            Case "A"
                Nb = CLng(Split(a(i), "/")(1)): j = 0
                Do
                    j = j + 1
                    st = st & u(90, 65)
                    If Len(st) >= 2 And e Then
                        If x(st) Then st = Left(st, Len(st) - 1): j = j - 1
                    End If
                Loop While j < Nb
            Case "a"
                Nb = CLng(Split(a(i), "/")(1)): j = 0
                Do
                    j = j + 1
                    st = st & u(122, 97)
                    If Len(st) >= 2 And e Then
                        If x(st) Then st = Left(st, Len(st) - 1): j = j - 1
                    End If
                Loop While j < Nb
            Case "9"
                Nb = CLng(Split(a(i), "/")(1)): j = 0
                Do
                    j = j + 1
                    st = st & u(57, 48)
                    If Len(st) >= 2 And e Then
                        If x(st) Then st = Left(st, Len(st) - 1): j = j - 1
                    End If
                Loop While j < Nb
            Case "!"
                Nb = CLng(Split(a(i), "/")(1)): j = 0
                Do
                    j = j + 1
                    st = st & v
                    If Len(st) >= 2 And e Then
                        If x(st) Then st = Left(st, Len(st) - 1): j = j - 1
                    End If
                Loop While j < Nb
        End Select
    Next i
    ttt = y(st)
End Function
Private Function u(m As Long, l As Long) As String

    Randomize Timer
    u = Chr(Int(((m - l + 1) * Rnd) + l))
End Function
Private Function v() As String

    Randomize Timer
    v = Mid("!""#$%&
End Function
Private Sub w(t As String, a As Boolean, b As Boolean, c As Boolean, d As Boolean)
    t = vbNullString: a = False: b = False: c = False: d = False
End Sub
Private Function x(s As String) As Boolean

Dim t, i As Long
Const d As String = "Il I1 l1 lI 1l 1I 0O O0 5S S5 2Z 2? Z? Z2 ?2 ?Z DO OD"
    t = Split(d, " ")
    For i = 0 To UBound(t)
        If Right(s, 2) = t(i) Then
            x = True: Exit Function
        End If
    Next
End Function
Private Function y(s As String) As String

Dim i&, t, r As String, d() As Long
    t = Split(StrConv(s, vbUnicode), Chr(0))
    d = z(UBound(t))
    For i = 0 To UBound(t)
        r = r & t(d(i))
    Next i
    y = Left(r, Len(r) - 1)
End Function
Private Function z(l As Long) As Long()

Dim i As Long, ou As Long, temp() As Long
Dim c As New Collection
    ReDim temp(l)
    If l = 1 Then
        temp(0) = 0
    ElseIf l = 2 Then
        temp(0) = 1: temp(1) = 0
    Else
        Randomize
        Do
            ou = Int(Rnd * l)
            On Error Resume Next
            c.Add CStr(ou), CStr(ou)
            If Err <> 0 Then
                On Error GoTo 0
            Else
                temp(ou) = i
                i = i + 1
            End If
        Loop While c.Count <> l
    End If
    z = temp
End Function




Ada: with Ada.Numerics.Discrete_Random;
with Ada.Strings.Fixed;
with Ada.Command_Line;
with Ada.Integer_Text_IO;
with Ada.Text_IO;

procedure Mkpw is

   procedure Put_Usage;
   procedure Parse_Command_Line (Success : out Boolean);
   function Create_Password (Length : in Positive;
                             Safe   : in Boolean)
                            return String;

   procedure Put_Usage is
      use Ada.Text_IO;
   begin
      Put_Line ("Usage:                                                     ");
      Put_Line ("   mkpw help   - Show this help text                       ");
      Put_Line ("   mkpw [count <n>] [length <l>] [seed 
] [safe]         ");
      Put_Line ("     count <n>  - Number of passwords generated (default 4)");
      Put_Line ("     length <l> - Password length (min 4)       (default 4)");
      Put_Line ("     seed <l>   - Seed for random generator     (default 0)");
      Put_Line ("     safe       - Do not use unsafe characters  (0O1lIS52Z)");
   end Put_Usage;

   Lower_Set  : constant String := "abcdefghijklmnopqrstuvwxyz";
   Upper_Set  : constant String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
   Digit_Set  : constant String := "0123456789";
   Spec_Set   : constant String := "!""#$%&'()*+,-./:;<=>?@[]^_{|}~";
   Unsafe_Set : constant String := "0O1lI5S2Z";

   Full_Set : constant String := Lower_Set & Upper_Set & Digit_Set & Spec_Set;
   subtype Full_Indices is Positive range Full_Set'Range;

   package Full_Index_Generator is
      new Ada.Numerics.Discrete_Random (Full_Indices);

   Index_Generator : Full_Index_Generator.Generator;

   Config_Safe          : Boolean  := False;
   Config_Count         : Natural  := 4;
   Config_Length        : Positive := 6;
   Config_Seed          : Integer  := 0;
   Config_Show_Help     : Boolean  := False;

   procedure Parse_Command_Line (Success : out Boolean) is
      use Ada.Command_Line;
      Got_Safe,   Got_Count : Boolean  := False;
      Got_Length, Got_Seed  : Boolean  := False;
      Last       : Positive;
      Index      : Positive := 1;
   begin
      Success := False;
      if Argument_Count = 1 and then Argument (1) = "help" then
         Config_Show_Help := True;
         return;
      end if;

      while Index <= Argument_Count loop
         if Ada.Command_Line.Argument (Index) = "safe" then
            if Got_Safe then
               return;
            end if;
            Got_Safe := True;
            Config_Safe     := True;
            Index := Index + 1;
         elsif Argument (Index) = "count" then
            if Got_Count then
               return;
            end if;
            Got_Count := True;
            Ada.Integer_Text_IO.Get (Item => Config_Count,
                                     From => Argument (Index + 1),
                                     Last => Last);
            if Last /= Argument (Index + 1)'Last then
               return;
            end if;
            Index := Index + 2;
         elsif Argument (Index) = "length" then
            if Got_Length then
               return;
            end if;
            Got_Length := True;
            Ada.Integer_Text_IO.Get (Item => Config_Length,
                                     From => Argument (Index + 1),
                                     Last => Last);
            if Last /= Argument (Index + 1)'Last then
               return;
            end if;
            if Config_Length < 4 then
               return;
            end if;
            Index := Index + 2;
         elsif Argument (Index) = "seed" then
            if Got_Seed then
               return;
            end if;
            Got_Seed := True;
            Ada.Integer_Text_IO.Get (Item => Config_Seed,
                                     From => Argument (Index + 1),
                                     Last => Last);
            if Last /= Argument (Index + 1)'Last then
               return;
            end if;
            Index := Index + 2;
         else
            return;
         end if;
      end loop;
      Success := True;
   exception
      when Constraint_Error | Ada.Text_IO.Data_Error =>
         null;
   end Parse_Command_Line;

   function Create_Password (Length : in Positive;
                             Safe   : in Boolean)
                            return String
   is

      function Get_Random (Safe : in Boolean)
                          return Character;

      function Get_Random (Safe : in Boolean)
                          return Character
      is
         use Ada.Strings.Fixed;
         C : Character;
      begin
         loop
            C := Full_Set (Full_Index_Generator.Random (Index_Generator));
            if Safe then
               exit when Index (Source => Unsafe_Set, Pattern => "" & C) = 0;
            else
               exit;
            end if;
         end loop;
         return C;
      end Get_Random;

      function Has_Four (Item : in String)
                        return Boolean;

      function Has_Four (Item : in String)
                        return Boolean
      is
         use Ada.Strings.Fixed;
         Has_Upper, Has_Lower : Boolean := False;
         Has_Digit, Has_Spec  : Boolean := False;
      begin
         for C of Item loop
            if Index (Upper_Set, "" & C) /= 0 then Has_Upper := True; end if;
            if Index (Lower_Set, "" & C) /= 0 then Has_Lower := True; end if;
            if Index (Digit_Set, "" & C) /= 0 then Has_Digit := True; end if;
            if Index (Spec_Set,  "" & C) /= 0 then Has_Spec  := True; end if;
         end loop;
         return Has_Upper and Has_Lower and Has_Digit and Has_Spec;
      end Has_Four;

      Password : String (1 .. Length);
   begin
      loop
         for I in Password'Range loop
            Password (I) := Get_Random (Safe);
         end loop;
         exit when Has_Four (Password);
      end loop;
      return Password;
   end Create_Password;

   Parse_Success : Boolean;
begin

   Parse_Command_Line (Parse_Success);

   if Config_Show_Help or not Parse_Success then
      Put_Usage;  return;
   end if;

   if Config_Seed = 0 then
      Full_Index_Generator.Reset (Index_Generator);
   else
      Full_Index_Generator.Reset (Index_Generator, Config_Seed);
   end if;

   for Count in 1 .. Config_Count loop
      Ada.Text_IO.Put_Line (Create_Password (Length => Config_Length,
                                             Safe   => Config_Safe));
   end loop;

end Mkpw;