Alpha-Numeric-Special

[Thales750]

If

Public Function IsComplex(sInput As String) As Boolean
Dim i As Integer
If Len(sInput) > 6 Then
  IsComplex = True
End If
Test1:
If IsComplex Then
    For i = 1 To Len(sInput)
      If IsNumeric(Mid(sInput, i, 1)) Then
          GoTo Test2 'My apologies.
      End If
   Next
   IsComplex = False
End If
Test2:
If IsComplex Then
   For i = 1 To Len(sInput)
       If Not IsNumeric(sInput) Then
           GoTo ExitFunction
       End If
   Next
   IsComplex = False
End If
ExitFunction:
End Function

Is to:
Minimum “7 Digits”, at least one “Numeric” character, and at least one “Alpha” character.

Then “Blank” is to:
Minimum “7 Digits”, at least one “Numeric” character”, at least one “Alpha” Character, and at least one “Special” character?

Thanks guys.

 

[gemma-the-husky]

did you mean this to be recursive? does it work?

 

[Galaxiom]

Public Function IsComplex(sInput As String) As Boolean
 
Dim InputLen as Integer
Dim Char As Integer
Dim i As Integer
Dim AlphaCount As Integer
Dim SpecialCount As Integer
Dim NumCount As Integer
 
InputLen = Len(sInput)
 
If InputLen > 6 Then
 
      For i = 1 To InputLen
          Char = Asc(Mid(sInput, i, 1))
 
          If (Char > 64 And Char < 91) Or (Char > 96 And Char < 123) Then
              AlphaCount = AlphaCount + 1
          ElseIf (Char > 46 And Char < 58) Then
              NumCount = NumCount + 1
          Else
              SpecialCount = SpecialCount + 1
          End If
 
          If NumCount > 0 And AlphaCount > 0 And SpecialCount > 0 Then
              IsComplex = True
              Exit For
          End If
 
      Next
End If
 
End Function

No spaghetti.

 

[Thales750]

Hey Guys,
　
Dave, I didn't mean it to be anything, meaning I found it in the Google Ether, maybe even here somewhere.
It seemed to work…
I tested them both with this test

Private Sub Text0_AfterUpdate()
If IsComplex(Me.Text0) = True Then
　
Me.Text2 = True
Else
Me.Text2 = False
End If
　
End Sub

The first one returned true and false for the following matrix
< 7 Digits = false
<1 Alpha = false
<1 Numeric = false


I tried the same thing on Galaxiom’s code.
There was a typo on this line I corrected.
　

Char = Mid(sInput, i, 1))

It has an extra ) at the end.

Plus both these lines need "Then" at the end

If (Char > 64 And Char < 91) Or (Char > 96 And Char < 123)
ElseIf (Char > 46 And Char < 58)

After that it works for counting the digits and works as expected when only numeric digits are present.

< 7 digits returns false
>7 digits returns false

It will except any input <7 digits as false,as you would expect from

If InputLen > 6 Then

However, if any type of character other than numeric it returns an error:


Type Mismatch
In the this line

If (Char > 64 And Char < 91) Or (Char > 96 And Char < 123)

This is much tighter code, and when I figure out this type mismatch thing, this will become perminent in the tool bag.

What I don't get about either one of these is how they are getting the ASCII value from the input.

 

[Galaxiom]

It was carelessly written aircode but you obviously got the picture. I actaully started out focussed on properly structuring the code. Then I read the bit at the bottem and thought the question was how to extend the orignal to function to include at least one special character.

The crucial error is in this line:
Char = Mid(sInput, i, 1))

Which should be:

 Char = Asc(Mid(sInput, i, 1))

The Char variable should be dimmed as Integer.

 

[Galaxiom]

This is much tighter code, and when I figure out this type mismatch thing, this will become perminent in the tool bag.

Since you liked that idea you will probably like this next one better.
It is configurable for having at least one numeric, alpha, mixed case and special character.

It is my pennance for posting that error-laden one.
I hope ths one has no errors.

Note the CharactersRequired() logical output is reversed from IsComplex() so that return codes can indicate the missing character types and still be interpreted as a Boolean True while an accepted return is zero (Boolean False).

I have not included Error handling because as far as I can see, short of the builtin functions being missing, (or a very, very long password) it is fairly bulletproof. To be sure, include Error handling in the calling procedure or add it yourself.

I have also attached it as an importable bas module for convenience and preserving the formatting that may have been lost in the posting.

EDIT (10/12/2014): I just spotted an oversight while linking to this code. I originally neglected to declare the arguments ByVal. As such they are passed ByRef (VBA default) and since I have modified the TestString in the function, this change will be passed back to the calling procedure.

It could potentially cause the submitted password to be changed.

I have now fixed it in the code box but still need to correct the attached file.

'---------------------------------------------------------------------------------------
' Module    : PasswordAnalysis
' Author    : Galaxiom
' Date      : 7/06/2011
' Updated   : 10/12/2014 to correct argument declaration to ByVal
' Purpose   : Testing complexity of string such as passwords
'---------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
 
Enum pwRequired
    pwNum = 1      ' Require at least one numeric character
    pwAlpha = 2    ' Require at least one Alpha character
    pwMixCase = 4  ' Require at least one of each both upper and low case characters
    pwSpecial = 8  ' Require at least one special character
End Enum
 
'---------------------------------------------------------------------------------------
' Procedure : RequiredCharacters
' Author    : Galaxiom
' Date      : 7/06/2011
' Purpose   : Test a string for:
'             Minimum number of characters
'             Presence of at least one of each of the designated character groups
' Usage     : Enter the minimum number of characters as the MinLength Argument
'             Add together each type of pwRequired type to the ReqChars argument
'             (pwAlpha is not required with pwMixCase)
'             Optionally set UseDialog to True to pop up a message about missing requirements
' Example   : RequiredCharacters(YourString, 4, pwNum + pwMixCase + pwSpecial, True)
'---------------------------------------------------------------------------------------
'
Public Function RequiredCharacters(ByVal TestString As String, ByVal MinLength As Integer, ByVal ReqChars As pwRequired, _
                            Optional ByVal UseDialog As Boolean = False) As Integer
 
' RETURN CODES:
' Characters Accepted = 0
 
' SUMMED RETURN CODES:
' Numeral required = 1
' Alpha or Lowercase character required = 2
' UpperCase character required = 4
' Special character required = 8
' Insufficient Characters = 16
 
Dim StringLen As Integer
Dim Char As Integer '.... ASCII value of character
Dim i As Integer
 
' Load pwAlpha if pwMixCase                (effect: require lowercase)
' Otherwise render TestString to lowercase (effect: detect uppercase as lower)
    If ReqChars <> (ReqChars And Not pwMixCase) Then
        ReqChars = ReqChars Or pwAlpha
    Else
        TestString = LCase(TestString)
    End If
 
' Include all active pwRequired values and length code in function return
    RequiredCharacters = ReqChars Or 16
 
    StringLen = Len(TestString)
 
' Remove each found RequiredCode from function return
 
    If Not StringLen < MinLength Then: RequiredCharacters = RequiredCharacters And Not 16
 
    For i = 1 To StringLen
        Char = Asc(Mid(TestString, i, 1))
 
        If (Char > 46 And Char < 58) Then                              ' Numeric
            RequiredCharacters = RequiredCharacters And Not pwNum
        ElseIf (Char > 96 And Char < 123) Then                         ' LowerCase
            RequiredCharacters = RequiredCharacters And Not pwAlpha
        ElseIf (Char > 64 And Char < 91) Then                          ' UpperCase
            RequiredCharacters = RequiredCharacters And Not pwMixCase
        Else                                                           ' Special
            RequiredCharacters = RequiredCharacters And Not pwSpecial
        End If
    Next
 
    If UseDialog And RequiredCharacters Then: RequiredCharsDialog (RequiredCharacters)
 
End Function
 
=======================================
Public Function RequiredCharsDialog(RequiredCode As Integer)
 
' Note: When using pwAlpha the "missing requirement" will be "At least one lowercase character"
'       even though an uppercase character would be accepted.
 
Dim NotPresent As String
 
    If RequiredCode <> 0 Then
        NotPresent = "The string still requires:" & vbCrLf & vbCrLf
        If (RequiredCode And Not 15) = 16 Then: NotPresent = NotPresent & "Additional characters" & vbCrLf
        If (RequiredCode And Not 23) = 8 Then: NotPresent = NotPresent & "At least one special character" & vbCrLf
        If (RequiredCode And Not 27) = 4 Then: NotPresent = NotPresent & "At least one uppercase Character" & vbCrLf
        If (RequiredCode And Not 29) = 2 Then: NotPresent = NotPresent & "At least one lowercase Character" & vbCrLf
        If (RequiredCode And Not 30) = 1 Then: NotPresent = NotPresent & "At least one numeric character" & vbCrLf
 
        MsgBox NotPresent
 
    End If
 
End Function
 
================================= 
Private Sub TestRequiredCharacters()
    If RequiredCharacters("1aA!", 4, pwNum + pwMixCase + pwSpecial, True) = False Then
        MsgBox "Accepted"
    End If
 
End Sub
 
' =============   Notes   =================
' The functions make extensive use of the Bitwise Operators.
' Each pwRequired value uses a single bit to indicate its inclusion in ReqChar.
' (Hence the binary pattern in their decimal values)
' The bitwise operators allow the bits to be operated on independently.
' This makes them useful where multiple independent values are held as a single number.
 
' X Or Y adds the bits without "carrying" as in arithmetic addition.
 
' X And Not Y subtracts the bits in the second operand from the first.
' Effectively this is subtraction without "borrowing".
' ==========================================

 

[Thales750]

You're a good person.

I am so far behind on this project, but I was thinking that I was going to add mixed case to it and post it back. I see you beat me to it.

Thanks again Galaxiom, you have helped me quite a pit.

Don't worry you are done yet, I have something extremely difficult coming, that I will surely need some help with.

Edit:
Now that I see what you did, I'm not sure I could have done it. Actually I'm sure I couldn't.

 

[Galaxiom]

Now that I see what you did, I'm not sure I could have done it. Actually I'm sure I couldn't.

You would be surprised. Sure bet you have learnt something by it and one day soon you will say "that is what I need to do".

It was not long ago I was asking here "what the hell is with Whatever eqauls Something And AnotherThing".

 

[Thales750]

You would be surprised. Sure bet you have learnt something by it and one day soon you will say "that is what I need to do".

It was not long ago I was asking here "what the hell is with Whatever eqauls Something And AnotherThing".

Possibly, but the rules are changing fast. Soon I will not be deleloping software, the needs of my business, are for me to develope the business.

Thanks again, we never know what the future brings.