Solved Detect 4 Sequential/Consecutive characters within a string

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:
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...
 
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
 
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:
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
    Quick Demo.zip
    493.3 KB · Views: 120
  • 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: 103
You must log in or register to reply here.

Similar threads

brucemc777
Solved HOW??? An HTML string stored in a long text table field with breaks for variables to be used in boilerplate eMails...
Replies
10
Views
368
brucemc777
brucemc777
N
Solved How to changes thousands of products prices in a retail business (The backed is SQL Server AZURE)
Replies
3
Views
493
nector
N
J
Promotion of short procedures: Splitting a string into lines
Replies
0
Views
595
Josef P.
J
A
Run-time error 52 Bad file name or number
Replies
11
Views
1,257
Pat Hartman
P
J
Interesting artical about what government can and can't do. It's a bit longish, but worth the read.
Replies
19
Views
533
moke123
moke123

Users who are viewing this thread

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