Question

我正在努力训练如何在弦乐的所有可能性之间循环，但我似乎没有进展得很好。

到目前为止，我已将一组角色放入一个阵列，但我不能让我的生活让我了解如何让它发挥作用。我已经走到了这一步，但我的大脑似乎无法绕过它。

任何人都可以说明正确的方法，也可能伪代码，这样我就可以创建自己的代码。

Function passwordGenerator(length As Integer)
    Dim characters() As String
    Dim x As Integer
    Dim y As Integer
    Dim p As Integer
    Dim t As Integer

    Dim oldpassword As String
    Dim newcharacter As String

    ReDim Preserve characters(1)

    For x = 48 To 90
        ReDim Preserve characters(UBound(characters) + 1)
        characters(UBound(characters) - 1) = VBA.Chr(x)
    Next x
    y = 1

        Do

            For x = 1 To length
            oldpassword = generateBlank(x)
            p = 1
                For t = 1 To p
                newpassword = WorksheetFunction.Replace(oldpassword, t, 1, characters(y))
                    For y = 1 To UBound(characters)
                        newpassword = WorksheetFunction.Replace(oldpassword, p, 1, characters(y))
                        Debug.Print newpassword
                        p = p + 1
                    Next y
                Next t
            Next x

        Loop


    End Function



Function generateBlank(length As Integer)

Dim x As Integer

For x = 1 To length
    generateBlank = generateBlank & "A"
Next x

End Function

EDIT :::

我已编辑了我的代码，但这样我必须知道长度并且不能创建有效的算法？有什么帮助吗？

Function passwordGenerator()
Dim characters() As String
Dim x As Integer
Dim y As Integer
Dim p As Integer
Dim t As Integer
Dim w As Integer
Dim e As Integer
Dim r As Integer
Dim u As Integer

Dim oldpassword As String
Dim newcharacter As String

ReDim Preserve characters(1)

For x = 48 To 90
    ReDim Preserve characters(UBound(characters) + 1)
    characters(UBound(characters) - 1) = VBA.Chr(x)
Next x
y = 1

oldpassword = generateBlank(3)
        For x = 1 To UBound(characters)
            oldpassword = WorksheetFunction.Replace(oldpassword, 1, 1, characters(x))
            For t = 1 To UBound(characters)
                oldpassword = WorksheetFunction.Replace(oldpassword, 2, 1, characters(t))
                For y = 1 To UBound(characters)
                    oldpassword = WorksheetFunction.Replace(oldpassword, 3, 1, characters(y))
                    For q = 1 To UBound(characters)
                        oldpassword = WorksheetFunction.Replace(oldpassword, 4, 1, characters(q))
                        For w = 1 To UBound(characters)
                            oldpassword = WorksheetFunction.Replace(oldpassword, 5, 1, characters(w))
                            Debug.Print oldpassword
                            DoEvents
                        Next w
                    Next q
                Next y
            Next t
        Next x
End Function

Answer 1

我认为这就是你想要的：

Public Function GeneratePassword(ByVal index As Long, ByVal pw_len As Byte, ByRef characters As String) As String
    ' Convert string 'characters' into array of characters in 'dict'
    Dim s As Integer, n As Integer
    n = Len(characters)
    Dim pw As String
    pw = vbNullString
    Dim j As Long, base As Long
    base = n
    For s = 1 To pw_len
        j = ((index - 1) Mod n) + 1
        pw = Mid(characters, j, 1) & pw
        index = (index - j) \ n + 1
    Next s
    GeneratePassword = pw
End Function


Public Sub TestPwGen()
    Dim i As Long, pw() As String, abc As String
    abc = "ABC"
    Dim n As Integer, l As Integer, m As Long
    ' password length 4, generate 18 passwords
    l = 4: m = Len(abc) ^ l 
    n = 18
    ReDim pw(1 To n)
    For i = 1 To n 'Total is m
        pw(i) = GeneratePassword(i, l, abc)
        Debug.Print pw(i)
    Next i
End Sub

结果：

AAAA
AAAB
AAAC
AABA
AABB
AABC
AACA
AACB
AACC
ABAA
ABAB
ABAC
ABBA
ABBB
ABBC
ABCA
ABCB
ABCC

Answer 2

我已经在JA72的答案中编辑了代码，以便提供更全面的技术来强制限制编辑＆＃34;密码。我删除了array和ReDim部分，并将它们全部合并为一个子部分。 JA方法的问题是，虽然它适用于ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789的字符集，但对于4个字符的密码（[26 + 26 + 10] ^ 4 = 14,776,336种可能性），它不能用于5个字符的密码（[26 + 26 + 10] ^ 5 = 916,132,832种可能性）。原始代码中的数组函数会导致32位Office应用程序在尝试使用5个字符或更多密码时立即耗尽内存。我还注意到内存使用率攀升，因为它使用原始代码迭代了1400万种可能性，而内存使用情况与下面的代码保持一致。

此示例专门针对Word ActiveDocument.Unprotect方法。它很简单，可以将尝试使用密码的部分更改为适合您需要的任何Office对象模型。

此代码在几个小时后为我工作，大约有4亿次密码尝试。我觉得它可能是哈希冲突与实际密码，但我会采取有效的方法。

如果您希望在提交几个小时的CPU之前看到输出工作，为方便起见，包含了一些内容。这在代码注释中也有解释。

通过编辑n变量来设置迭代次数。
将第一个循环For i = 1 to m更改为For i = 1 to n，以便循环这么多次而不是所有可能的次。
取消注释第If i Mod showEvery = 0 Then Debug.Print i, pw行，打开输出。
如果您想查看每个密码：请将showEvery设置为1，否则请选择其他号码以查看每个第n个密码。
评论实际尝试密码ActiveDocument.Unprotect的部分并检查错误。它在代码中标记了注释。

Sub GetPassword()

Dim s As Integer, totalChars As Integer, j As Long  'GeneratePassword loop vars
Dim gpi As Long           'GeneratePassword index
Dim characters As String  'characters that can be part of the password.
Dim pw As String          'password attempt string

characters = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
totalChars = Len(characters)

Dim i As Double           'count integer
Dim n As Double           'number of interations to complete (if active)
Dim pwLen As Integer      'length of password
Dim m As Double           'number of permutations
Dim showEvery As Integer  'show multiples of this in debug log

pwLen = 5                 'password length
m = totalChars ^ pwLen    'number of potential combinations of characters for the length
n = 1000                  'number of loop iterations if you don't want all of them.
showEvery = 1             'use 1 here to show every password.  10000 shows every 10,000th password, etc...

On Error Resume Next      'no need to invoke an error handler, just check the Err.Number
For i = 1 To m  'use "1 to n" if you want to test a certain number or "1 to m" if you want try all combinations.
    pw = vbNullString
    gpi = i     'assign GeneratePassword loop integer our loop integer
    'GeneratePassword loop
    For s = 1 To pwLen
        j = ((gpi - 1) Mod totalChars) + 1
        pw = Mid(characters, j, 1) & pw
        gpi = (gpi - j) \ totalChars + 1
    Next s

    'writes out if uncommented and it's the right i. comment out once you're sure of the output.
    'If i Mod showEvery = 0 Then Debug.Print i, pw

    'try the password to unprotect the document, comment if just testing passwords in Immediate window
    ActiveDocument.Unprotect password:=pw
    If Err.Number <> 5485 Then
        MsgBox "Unexpected Error Code: " & Err.Number & vbCrLf & Err.Description & vbCrLf & pw
    End If
    If ActiveDocument.ProtectionType = wdNoProtection Then
        MsgBox "Unprotected with password: " & vbCrLf & pw
        Debug.Print "Unprotect Password:  " & pw
        Exit Sub
    End If
    'end trying the password.

Next i

End Sub

Answer 3

不幸的是，在我不得不写下我的解决方案之前，这个问题一直困扰着我。我认为@ ja72的解决方案更优雅，但我会列出我的另一种方式。

Option Explicit

Function passwordGenerator()
    Dim characters() As String
    Dim loASCII As Integer
    Dim hiASCII As Integer
    Dim numASCII As Integer
    Dim i As Integer

    loASCII = 48
    hiASCII = 90
    numASCII = hiASCII - loASCII
    ReDim characters(numASCII)
    For i = loASCII To hiASCII
        characters(i - loASCII) = VBA.Chr(i)
    Next i

    PermutationsOn characters, 2

End Function

Sub PermutationsOn(ByRef charSet() As String, numPlaces As Integer)
    '--- Generates every possible combination of characters from the given
    '    character set for an n-place string
    '    Inputs: charSet   - string array of all possible values
    '            numPlaces - integer noting how many characters in the output string
    Dim chars() As String
    Dim thisString As String
    Dim i As Integer
    Dim t As Long
    Dim numInCharSet As Integer
    Dim start As Integer
    Dim placevalues() As Integer

    '--- this array is used as a set of indexes into the character set, the
    '    indexes will range from charSet(0) to charSet(last), "counting" as
    '    in a base-n number, where n = len(charSet)+1
    ReDim placevalues(1 To numPlaces) As Integer
    ReDim chars(1 To numPlaces)

    start = LBound(charSet)
    numInCharSet = UBound(charSet)
    '--- initialize the arrays
    For i = 1 To numPlaces
        placevalues(i) = 0
    Next i
    For i = 1 To numPlaces
        chars(i) = charSet(start)
    Next i
    Debug.Print "Permutations on a " & numPlaces & "-place value from a character set"
    Debug.Print "Character set (len=" & numInCharSet + 1 & "): '" & ConcatToString(charSet) & "'"

    '--- build the first string...
    t = 1
    thisString = BuildStringFromSet(placevalues, charSet)
    Debug.Print t & ": " & thisString
    Do Until IncrementValues(placevalues, charSet)
        '--- build the current string...
        thisString = BuildStringFromSet(placevalues, charSet)
        t = t + 1
        Debug.Print t & ": " & thisString
    Loop
    Debug.Print "Total strings generated: " & t
End Sub

Function IncrementValues(ByRef placevalues() As Integer, ByRef placeRange() As String) As Boolean
    '--- views the placeValues array as a "single" number with a numeric base of "numInRange+1"
    Dim highestValueReached As Boolean
    Dim numPlaces As Integer
    Dim numInRange As Integer
    Dim i As Integer
    numPlaces = UBound(placevalues)
    numInRange = UBound(placeRange)
    highestValueReached = False
    For i = 1 To numPlaces
        If placevalues(i) <> numInRange Then
            placevalues(i) = placevalues(i) + 1
            Exit For
        Else
            If i = numPlaces Then
                highestValueReached = True
                Exit For
            Else
                placevalues(i) = 0
            End If
        End If
    Next i
    IncrementValues = highestValueReached
End Function

Function BuildStringFromSet(ByRef placevalues() As Integer, ByRef charSet() As String) As String
    Dim i As Integer
    Dim finalString As String
    finalString = ""
    For i = UBound(placevalues) To 1 Step -1
        finalString = finalString & charSet(placevalues(i))
    Next i
    BuildStringFromSet = finalString
End Function

Function ConcatToString(chars() As String) As String
    Dim finalString As String
    Dim j As Integer
    finalString = ""
    For j = LBound(chars) To UBound(chars)
        finalString = finalString & chars(j)
    Next j
    ConcatToString = finalString
End Function

输出结果：

Permutations on a 5-place value from a character set
Character set (len=43): '0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ'
1: 00000
2: 00001
3: 00002
4: 00003
...
147008441: ZZZZX
147008442: ZZZZY
147008443: ZZZZZ
Total strings generated: 147008443

Answer 4

我实际上想出了一个答案我自己的答案。今天在工作中找到了我。

Public characters() As String
Public oldpassword As String

Function passwordGenerator1(maxLength)

Dim x As Integer, newcharacter As String
ReDim Preserve characters(1)

'set characters in array
    For x = 48 To 90
        ReDim Preserve characters(UBound(characters) + 1)
        characters(UBound(characters) - 1) = VBA.Chr(x)
    Next x

'loop through all lengths
    For x = 1 To maxLength
        oldpassword = generateBlank(x)
        changeCharacter 1, x
    Next x
End Function

-

Function changeCharacter(characterPos, length As Integer)

    For x = 1 To UBound(characters)
        If characterPos <> length Then changeCharacter characterPos + 1, length
        oldpassword = WorksheetFunction.Replace(oldpassword, characterPos, 1, characters(x))
        Debug.Print oldpassword
        DoEvents
    Next x

End Function

-

Function generateBlank(length As Integer)

Dim x As Integer

    For x = 1 To length
        generateBlank = generateBlank & "A"
    Next x

End Function

Answer 5

这可能会有所改进，但一个简单的想法是分别处理角色并像里程表那样滚动。顺便说一下，我为数组使用了基于一的索引，但是对于各个数字使用了从零开始的索引。

Public Sub PasswordGen()
Const MaxDigit = 42
Const MaxLoops = MaxDigit * MaxDigit * MaxDigit * MaxDigit * MaxDigit
Dim places(10) As Integer
Dim counter As Integer
Dim digit As Integer
Dim password As String

counter = 0
Do While counter < MaxLoops
    password = Chr(places(5) + 48) & Chr(places(4) + 48) & Chr(places(3) + 48) & Chr(places(2) + 48) & Chr(places(5) + 48)
    'Debug.Print password
    counter = counter + 1
    digit = 1
    Do While digit < 10
        places(digit) = places(digit) + 1
        If places(digit) = MaxDigit Then
            places(digit) = 0
            digit = digit + 1
        Else
            Exit Do
        End If
    Loop
Loop
End Sub

你也可以取消计数器，当数字等于11时退出循环，因为第十位的执行（溢出）。无论如何，我怀疑你实际上会让它运行那么久。

暴力密码VBA

5 个答案: