Solved Detect 4 Sequential/Consecutive characters within a string (1 Viewer)

E

ebs17

Well-known member
Local time
Today, 09:12
Joined
Feb 7, 2020
Messages
1,946
Based on the mentioned evaluation with percentage progress, I made a small revision and now organized the output of the counts of the individual tests using a user-defined type.
Code: 
Public Type PWElements
    LenPW As Long
    Numbers As Long
    Uppercase As Long
    Lowercase As Long
    SpecialCharacter As Long
    Repeat4 As Long
    Consecutive4 As Long
End Type

Public Function TestPassword(sPW As String) As PWElements
    Dim bytArrPW() As Byte
    Dim sDiff() As String
    Dim lCount As Long
    Dim sSeries As String
    Dim i As Long
    Dim lNumber As Long
    Dim lUppercase As Long
    Dim lLowercase As Long
    Dim lSpecialCharacter As Long
    Dim myPWE As PWElements

    bytArrPW() = StrConv(sPW, vbFromUnicode)
    lCount = UBound(bytArrPW)
    ReDim sDiff(lCount)
    For i = 0 To lCount
        Select Case bytArrPW(i)
            Case 48 To 57
                lNumber = lNumber + 1
            Case 65 To 90
                lUppercase = lUppercase + 1
            Case 97 To 122
                lLowercase = lLowercase + 1
            Case 33 To 47, 58 To 64, 91 To 96
                lSpecialCharacter = lSpecialCharacter + 1
        End Select
    Next
   
    myPWE.LenPW = Len(sPW)
    myPWE.Numbers = lNumber
    myPWE.Uppercase = lUppercase
    myPWE.Lowercase = lLowercase
    myPWE.SpecialCharacter = lSpecialCharacter

    For i = 1 To lCount
        sDiff(i) = CLng(bytArrPW(i)) - CLng(bytArrPW(i - 1))
    Next
    sSeries = Join(sDiff, "|")

    myPWE.Repeat4 = UBound(Split(sSeries, "0|0|0|"))
    myPWE.Consecutive4 = UBound(Split(sSeries, "1|1|1|"))

    TestPassword = myPWE

End Function
Code: 
Sub call_TestPW()
    Dim xPWE As PWElements
    xPWE = TestPassword("<TaaaaB2345%d@x")
    Debug.Print xPWE.LenPW, _
                xPWE.Numbers, _
                xPWE.Uppercase, _
                xPWE.Lowercase, _
                xPWE.SpecialCharacter, _
                xPWE.Repeat4, _
                xPWE.Consecutive4
End Sub

I think this is very clear and easily expandable for additional tests.
 
Last edited:
Jason Lee Hayes

Jason Lee Hayes

Active member
Local time
Today, 08:12
Joined
Jul 25, 2020
Messages
175
ebs17 said:
Based on the mentioned evaluation with percentage progress, I made a small revision and now organized the output of the counts of the individual tests using a user-defined type.
Code: 
Public Type PWElements
    LenPW As Long
    Numbers As Long
    Uppercase As Long
    Lowercase As Long
    SpecialCharacter As Long
    Repeat4 As Long
    Consecutive4 As Long
End Type

Public Function TestPassword(sPW As String) As PWElements
    Dim bytArrPW() As Byte
    Dim sDiff() As String
    Dim lCount As Long
    Dim sSeries As String
    Dim i As Long
    Dim lNumber As Long
    Dim lUppercase As Long
    Dim lLowercase As Long
    Dim lSpecialCharacter As Long
    Dim myPWE As PWElements

    bytArrPW() = StrConv(sPW, vbFromUnicode)
    lCount = UBound(bytArrPW)
    ReDim sDiff(lCount)
    For i = 0 To lCount
        Select Case bytArrPW(i)
            Case 48 To 57
                lNumber = lNumber + 1
            Case 65 To 90
                lUppercase = lUppercase + 1
            Case 97 To 122
                lLowercase = lLowercase + 1
            Case 33 To 47, 58 To 64, 91 To 96
                lSpecialCharacter = lSpecialCharacter + 1
        End Select
    Next
  
    myPWE.LenPW = Len(sPW)
    myPWE.Numbers = lNumber
    myPWE.Uppercase = lUppercase
    myPWE.Lowercase = lLowercase
    myPWE.SpecialCharacter = lSpecialCharacter

    For i = 1 To lCount
        sDiff(i) = CLng(bytArrPW(i)) - CLng(bytArrPW(i - 1))
    Next
    sSeries = Join(sDiff, "|")

    myPWE.Repeat4 = UBound(Split(sSeries, "0|0|0|"))
    myPWE.Consecutive4 = UBound(Split(sSeries, "1|1|1|"))

    TestPassword = myPWE

End Function
Code: 
Sub call_TestPW()
    Dim xPWE As PWElements
    xPWE = TestPassword("<TaaaaB2345%d@x")
    Debug.Print xPWE.LenPW, _
                xPWE.Numbers, _
                xPWE.Uppercase, _
                xPWE.Lowercase, _
                xPWE.SpecialCharacter, _
                xPWE.Repeat4, _
                xPWE.Consecutive4
End Sub
Click to expand...
 
K

KitaYama

Well-known member
Local time
Today, 16:12
Joined
Jan 6, 2022
Messages
1,541
ebs17 said:
Based on the mentioned evaluation with percentage progress, I made a small revision and now organized the output of the counts of the individual tests using a user-defined type.
Code: 
Public Type PWElements
    LenPW As Long
    Numbers As Long
    Uppercase As Long
    Lowercase As Long
    SpecialCharacter As Long
    Repeat4 As Long
    Consecutive4 As Long
End Type

Public Function TestPassword(sPW As String) As PWElements
    Dim bytArrPW() As Byte
    Dim sDiff() As String
    Dim lCount As Long
    Dim sSeries As String
    Dim i As Long
    Dim lNumber As Long
    Dim lUppercase As Long
    Dim lLowercase As Long
    Dim lSpecialCharacter As Long
    Dim myPWE As PWElements

    bytArrPW() = StrConv(sPW, vbFromUnicode)
    lCount = UBound(bytArrPW)
    ReDim sDiff(lCount)
    For i = 0 To lCount
        Select Case bytArrPW(i)
            Case 48 To 57
                lNumber = lNumber + 1
            Case 65 To 90
                lUppercase = lUppercase + 1
            Case 97 To 122
                lLowercase = lLowercase + 1
            Case 33 To 47, 58 To 64, 91 To 96
                lSpecialCharacter = lSpecialCharacter + 1
        End Select
    Next
  
    myPWE.LenPW = Len(sPW)
    myPWE.Numbers = lNumber
    myPWE.Uppercase = lUppercase
    myPWE.Lowercase = lLowercase
    myPWE.SpecialCharacter = lSpecialCharacter

    For i = 1 To lCount
        sDiff(i) = CLng(bytArrPW(i)) - CLng(bytArrPW(i - 1))
    Next
    sSeries = Join(sDiff, "|")

    myPWE.Repeat4 = UBound(Split(sSeries, "0|0|0|"))
    myPWE.Consecutive4 = UBound(Split(sSeries, "1|1|1|"))

    TestPassword = myPWE

End Function
Code: 
Sub call_TestPW()
    Dim xPWE As PWElements
    xPWE = TestPassword("<TaaaaB2345%d@x")
    Debug.Print xPWE.LenPW, _
                xPWE.Numbers, _
                xPWE.Uppercase, _
                xPWE.Lowercase, _
                xPWE.SpecialCharacter, _
                xPWE.Repeat4, _
                xPWE.Consecutive4
End Sub

I think this is very clear and easily expandable for additional tests.
Click to expand...
@ebs17 is this correct?

Code: 
?TestPassword("abcd3333").Repeat4
 0

?TestPassword("abcd").Consecutive4
 0
 
?TestPassword("3333").Repeat4
 0
 
E

ebs17

Well-known member
Local time
Today, 09:12
Joined
Feb 7, 2020
Messages
1,946
No, I think this shortening of the evaluation is not permissible.

If you change the function's return to an array, you could work in the direction shown, since a one-dimensional array is a collection.
Code: 
Public Function TestPassword(sPW As String) As Variant
   Dim lArr(6) As Long
   ' ...
   lArr(0) = Len(sPW)
   ' ...
   TestPassword = lArr
End Function

' ----------------------------------------------------

?TestPassword("abcd3333")(6)
In this use, however, you have your own function call for each value display, which is less efficient if it is repeated several times.
This is a little more direct, but less speaking. You have to know the index of the collection here, before it was a name of the element.

In #25 I showed the output as a string. Additional information to explain the values could be built into the string. Then you just have to reevaluate it.
 
Last edited:
Jason Lee Hayes

Jason Lee Hayes

Active member
Local time
Today, 08:12
Joined
Jul 25, 2020
Messages
175
Been making some real progress with everyone's help. Just a quick demo i made to test the function.
Minimum 10 characters, minimum 2 Upper, 2 Lower, 1 Special Character, No Sequencing or Repeat within 4 block, no commonly used passwords. My progress bar works... Now need to tidy the code up and implement into my user form.
 

Attachments

  • Quick Demo.zip
    493.3 KB · Views: 84
  • Screen Shot 02-23-21 at 12.47 AM 001.PNG
    Screen Shot 02-23-21 at 12.47 AM 001.PNG
    207.9 KB · Views: 73
Jason Lee Hayes

Jason Lee Hayes

Active member
Local time
Today, 08:12
Joined
Jul 25, 2020
Messages
175
Finally implemented the password check routine... Thanks for all your help....
 

Attachments

  • SignUp (Password Check Routine).zip
    3.6 MB · Views: 78
You must log in or register to reply here.

Similar threads

N
Solved How to changes thousands of products prices in a retail business (The backed is SQL Server AZURE)
Replies
3
Views
344
nector
N
J
Promotion of short procedures: Splitting a string into lines
Replies
0
Views
511
Josef P.
J
A
Run-time error 52 Bad file name or number
Replies
11
Views
936
Pat Hartman
P
A
Returning a list of keywords based on partial matches
Replies
4
Views
883
Alc
A
I
Can we add a sequential + unique article number other than ID in Multiuser front end environment
Replies
7
Views
1,163
theDBguy
theDBguy

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom