Генерация ключей

[Dex]

пишу прогу и не могу сделать генерацию ключей.
У меня на форме ListBox его Style CheckBox в свойстве List различные символы.Мне нужно чтоб когда нажимал кнопку у меня в TextBox'е
писалось набор символов наобум из выбранных.Ну например:
Символы:1234567890!@#$%^&*()-+=abcdefgh...
И в TextBox'е вывадились символы в различном порядке и в разном количестве из выбранных:
1hd564nv8 или 23#&f7%.
Ну кто-нидь мозет помочь?

[hCORe]

Sorry, был какой-то сбой форума
Я отвечал в одну тему, но сообщение перешло в другую. Мистика, да и только

[GSerg]

[deleted]Зачем???[/deleted]

InStr, Mid$ да Rnd...


[edit]Это и я потом понял [/edit]

[alibek]

Предлагаю:

Код: Выделить всё

Public Const cDigits As String = "0123456789"
Public Const cLLetter As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Public Const cRLetter As String = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЫЪЭЮЯ"
Public Const cLetter As String = cDigits & cLLetter & cRLetter
Public Const cChars As String = cLetter & vbSpace & "_-"
Public Const cWD As String = " ,;:-", cTD As String = ".!?"
Public Const cDLM As String = cWD & cTD

Function GenerateKeyPhrase(Optional ByVal PhraseLength As Long) As String
Dim res As String, I As Long, C As Byte, S As String, N As Long
If PhraseLength = 0 Then
  Randomize
  PhraseLength = 20 + Rnd * 20
End If
Randomize
S = Choose(1 + Fix(Rnd * 3), cRLetter, cLLetter, cDigits)
For I = 1 To PhraseLength
  C = 1 + Fix(Rnd * Len(S))
  N = N + 1
  If N >= Rnd * 10 And N > 1 Then
    C = 0
    N = 0
    Randomize
    S = IIf(Rnd > 0.5, cRLetter, cLLetter) & IIf(Rnd < 0.25, cDigits, vbNullString)
  End If
  If C = 0 Then
    res = res & vbSpace
  Else
    If N = 1 Then
      res = res & UCase$(Mid$(S, C, 1))
    Else
      res = res & LCase$(Mid$(S, C, 1))
    End If
  End If
Next I
GenerateKeyPhrase = res
End Function


[TEH3OP]

Предлогаю...

Код: Выделить всё

Public Declare Function IsCharAlpha Lib "user32.dll" Alias "IsCharAlphaW" (ByVal cChar As Byte) As Long
Public Declare Function IsCharAlphaNumeric Lib "user32.dll" Alias "IsCharAlphaNumericW" (ByVal cChar As Byte) As Long

Public Sub Main()
    VBA.MsgBox StringGenerate
End Sub

Public Function StringGenerate() As String
Const MAX_LEN As Long = 50&
Const MIN_LEN As Long = 10&
Const MAX_CHAR As Byte = 255
   
    Dim bstReturn As String
    Dim lngLen As Long
    Dim bytCurChar As Byte
    Dim k As Long
   
    VBA.Randomize
   
    lngLen = VBA.Rnd() * (MAX_LEN - MIN_LEN) + MIN_LEN
   
    For k = 0& To lngLen
        Do
            bytCurChar = VBA.Rnd() * MAX_CHAR
        Loop Until IsCharAlpha(bytCurChar) <> 0& Or IsCharAlphaNumeric(bytCurChar) <> 0&
        bstReturn = bstReturn & VBA.Chr$(bytCurChar)
    Next k
    StringGenerate = bstReturn
End Function

[alibek]

Краткость сестра таланта... двоюродная...

А мое более криптостойкое
Обычное Chr$(32+RND*(255-32)) меня не устраивало потому, что... Просто не устраивало. А моя процедура генерит группы, причем в пределах одной группы кириллица и латинница не смешиваются.

[Andrey Fedorov]

А моя процедура генерит группы, причем в пределах одной группы кириллица и латинница не смешиваются.

А похорошему надо еще чтобы не было символов со схожим написанием. То есть в шифре не должно быть, к примеру, цифры 0 и буквы O, цифры 1 и буквы I и т. д. В общем, чтобы все легко читалось и пользователю не надо было вглядываться в текст чтобы определить что это - буква или цифра (ну и самому при этом проблем меньше будет)...

[TEH3OP]

А похорошему надо еще чтобы не было символов со схожим написанием. То есть в шифре не должно быть, к примеру, цифры 0 и буквы O, цифры 1 и буквы I и т. д. В общем, чтобы все легко читалось и пользователю не надо было вглядываться в текст чтобы определить что это - буква или цифра (ну и самому при этом проблем меньше будет)...

IMHO пароль должен быть трудновзламываем, а не легкочитаем. Убирание из пароля определённых символов упрощает его взламывание.

[Andrey Fedorov]

IMHO пароль должен быть трудновзламываем, а не легкочитаем.

Речь-то шла не о пароле (который задает сам пользователь) а о коде регистрации программы - он должен хорошо читаться. А насчет "трудновзламываем" - дык кто-же из взломщиков его вручную (и даже на автомате) подбирает - им гораздо проще взломать саму программу или выложить пароль одной купленной копии...

[TEH3OP]

А мое более криптостойкое :)

Поясни пожалуйста смысл термина. (вопрос без сарказма)

Обычное Chr$(32+RND*(255-32)) меня не устраивало потому, что... Просто не устраивало.

Дык и у меня не обычное Chr$(32+RND*(255-32)).

А моя процедура генерит группы, причем в пределах одной группы кириллица и латинница не смешиваются.

+ А моя работает быстрее!
+ И человеку надо сгенерить любую строку, а про смешивание русских\латинских разговора не было. "Не нужен грузовик, когда надо перевезти одну табуретку через два квартала."
+ Хм... мою можно подпеределать, добавив в неё возможность указания/выбора диапазона значений кодов символов, И ОНА ВСЁРАВНО БУДЕТ РАБОТАТЬ БЫСТРЕЕ. ;-)

ЗЫ: никого не опускаю -- просто спорю. С умным человеком завсегда приятно поспорить! ;-)

[alibek]

Ну криптостойкое - это я слово неправильное подобрал. Просто в качестве пароля/ключа, который необходимо каким-либо образом запомнить, такие группы гораздо удобнее.
Вот представь, твой алгоритм сгенерирует строку "0000000000000" (а он, кстати, не исключает такую возможность). У меня же это практически (хотя и не абсолютно) исключено.

У тебя же ключевым является bytCurChar = VBA.Rnd() * MAX_CHAR. А теперь представь себе ситуацию (согласен, очень маловероятную), когда на 10-15 тысяч раз подряд RND будет генерировать значения в диапазоне 0...31? Тогда эта процедура подвесит всю программу. И пусть эта ситуация маловероятно, но такие ситуации надо исключать в принципе. У меня, например, подобной ситуации не возникнет никогда; при генерации пароля будет выполнено ровно PhraseLength проходов.

Работает быстрее - спорный вопрос (см. выше). Согласен, но с оговоркой, что не будет пустых проходов в цикле Do...Loop.
Насчет любой строки - если уж придираться к словам, он и код не просил, он просил помочь Можно было ему просто выложить пару десяткой сгенерированных строк
Переработать твою процедуру на то, чтобы добавляемые символы были из произвольного диапазона не так уж и элементарно (несложно, но тогда она получится длиннее, чем моя)

[TEH3OP]

Ну криптостойкое - это я слово неправильное подобрал. Просто в качестве пароля/ключа, который необходимо каким-либо образом запомнить, такие группы гораздо удобнее.
Вот представь, твой алгоритм сгенерирует строку "0000000000000" (а он, кстати, не исключает такую возможность). У меня же это практически (хотя и не абсолютно) исключено.

Хм, что плохого в строке "0000000000000"? Строка как строка... Но повторяться она не должна, а для этого держится БД со сгенерёнными ключами и проверка наличия ключа в БД, ведётся не в этой функции.

И вообще, если уж на то пошло, то самое тупое использовать CoCreateGUID.

У тебя же ключевым является bytCurChar = VBA.Rnd() * MAX_CHAR. А теперь представь себе ситуацию (согласен, очень маловероятную), когда на 10-15 тысяч раз подряд RND будет генерировать значения в диапазоне 0...31? Тогда эта процедура подвесит всю программу. И пусть эта ситуация маловероятно, но такие ситуации надо исключать в принципе.

В принцыпе, если считать вероятность выпадения каждого числа из диапазона одинаковой (ф-я распределения F=k (const)), то из 255 чисел, вероятность вылететь числу из [0;31] равна 0.1216 -- калькулятор зашкаливает при попытке рассчитать число итераций, гарантирующих даже с вероятностью 0.5, ситуацию с 10000 успехов подряд. Короче, опять "на грузовике табуретку..." получается

У меня, например, подобной ситуации не возникнет никогда; при генерации пароля будет выполнено ровно PhraseLength проходов.

Прикол в том, что мой и твой проход оч. разняться по скорости.

Работает быстрее - спорный вопрос (см. выше). Согласен, но с оговоркой, что не будет пустых проходов в цикле Do...Loop.
Насчет любой строки - если уж придираться к словам, он и код не просил, он просил помочь :) Можно было ему просто выложить пару десяткой сгенерированных строк :)

Согласен.

Переработать твою процедуру на то, чтобы добавляемые символы были из произвольного диапазона не так уж и элементарно (несложно, но тогда она получится длиннее, чем моя)

Хм... да нефига! 8-)

Код: Выделить всё

Public Declare Function IsCharAlpha Lib "user32.dll" Alias "IsCharAlphaW" (ByVal cChar As Byte) As Long
Public Declare Function IsCharAlphaNumeric Lib "user32.dll" Alias "IsCharAlphaNumericW" (ByVal cChar As Byte) As Long

Public Sub Main()
    Dim abytRanges(3) As Byte
    abytRanges(0) = VBA.Asc("A")
    abytRanges(1) = VBA.Asc("Z")
    abytRanges(2) = VBA.Asc("0")
    abytRanges(3) = VBA.Asc("9")
    VBA.MsgBox StringGenerate(abytRanges)
End Sub

Public Function StringGenerate(ByRef iRanges() As Byte) As String
Const MAX_LEN As Long = 50&
Const MIN_LEN As Long = 10&
Const MAX_CHAR As Byte = 255
   
    Dim bstReturn As String
    Dim lngLen As Long
    Dim lngRangesCount As Long
    Dim lngCurRangeIdx As Long
    Dim bytCurChar As Byte
    Dim k As Long
    Dim abytRanges() As Byte
   
    abytRanges() = iRanges
    lngRangesCount = UBound(abytRanges)
    If Not lngRangesCount And 1& Then
        lngRangesCount = lngRangesCount + 1
        ReDim abytRanges(0 To lngRangesCount) As Byte
        abytRanges(lngRangesCount) = MAX_CHAR
    End If
   
    lngRangesCount = lngRangesCount \ 2&
    VBA.Randomize
   
    lngLen = VBA.Rnd() * (MAX_LEN - MIN_LEN) + MIN_LEN
   
    For k = 0& To lngLen
        Do
            lngCurRangeIdx = VBA.Rnd() * lngRangesCount
            bytCurChar = abytRanges(lngCurRangeIdx * 2) + _
                VBA.Rnd() * (abytRanges(lngCurRangeIdx * 2 + 1&) - abytRanges(lngCurRangeIdx * 2))
        Loop Until IsCharAlpha(bytCurChar) <> 0& Or IsCharAlphaNumeric(bytCurChar) <> 0&
        bstReturn = bstReturn & VBA.Chr$(bytCurChar)
    Next k
    StringGenerate = bstReturn
End Function

[alibek]

Ты учти, что RND дает не случайное число, а ПСЕВДОСЛУЧАЙНОЕ. И если знать алгоритм его формирования, можно подобрать такое значение Randomize, что данная ситуация как-раз и возникнет. Вероятность, что 1000 раз подряд будет выпадать числа в диапазоне 0...31 равна (примерно) 8.128548625558E-904, но дело не в вероятности, а в принципиальной возможности такой ситуации. Мало ли, может математический сопроцессор глюк словит и всегда будет RND()=0.

Насчет твоего доработанного варианта - а теперь сравни его с моим? И еще учти, что константы cLetter и прочие можно использовать в других целях (у меня, к примеру, они используются для орфографического анализа), т.е. их можно исключить из листинга.

И вообще, лучше объясняться фактами.

Код: Выделить всё

'Форма Form1, кнопка Command1
Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Declare Function IsCharAlpha Lib "user32.dll" Alias "IsCharAlphaW" (ByVal cChar As Byte) As Long
Private Declare Function IsCharAlphaNumeric Lib "user32.dll" Alias "IsCharAlphaNumericW" (ByVal cChar As Byte) As Long

Private Const vbSpace As String = " "

Private Const cDigits As String = "0123456789"
Private Const cLLetter As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Private Const cRLetter As String = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЫЪЭЮЯ"
Private Const cLetter As String = cDigits & cLLetter & cRLetter
Private Const cChars As String = cLetter & vbSpace & "_-"
Private Const cWD As String = " ,;:-", cTD As String = ".!?"
Private Const cDLM As String = cWD & cTD

Function GenerateKeyPhrase(Optional ByVal PhraseLength As Long) As String
Dim res As String, I As Long, C As Byte, S As String, N As Long
If PhraseLength = 0 Then
  Randomize
  PhraseLength = 20 + Rnd * 20
End If
Randomize
S = Choose(1 + Fix(Rnd * 3), cRLetter, cLLetter, cDigits)
For I = 1 To PhraseLength
  C = 1 + Fix(Rnd * Len(S))
  N = N + 1
  If N >= Rnd * 10 And N > 1 Then
    C = 0
    N = 0
    Randomize
    S = IIf(Rnd > 0.5, cRLetter, cLLetter) & IIf(Rnd < 0.25, cDigits, vbNullString)
  End If
  If C = 0 Then
    res = res & vbSpace
  Else
    If N = 1 Then
      res = res & UCase$(Mid$(S, C, 1))
    Else
      res = res & LCase$(Mid$(S, C, 1))
    End If
  End If
Next I
GenerateKeyPhrase = res
End Function

Function StringGenerate() As String
Const MAX_LEN As Long = 50&
Const MIN_LEN As Long = 10&
Const MAX_CHAR As Byte = 255
   
    Dim bstReturn As String
    Dim lngLen As Long
    Dim bytCurChar As Byte
    Dim k As Long
   
    VBA.Randomize
   
    lngLen = VBA.Rnd() * (MAX_LEN - MIN_LEN) + MIN_LEN
   
    For k = 0& To lngLen
        Do
            bytCurChar = VBA.Rnd() * MAX_CHAR
        Loop Until IsCharAlpha(bytCurChar) <> 0& Or IsCharAlphaNumeric(bytCurChar) <> 0&
        bstReturn = bstReturn & VBA.Chr$(bytCurChar)
    Next k
    StringGenerate = bstReturn
End Function

Private Sub Test1()
Dim TT0 As Long, TT As Long, TTA As Long, T As Long
Dim C As Long, I As Long, S As String
Const N As Long = 10000, NC As Long = 5
TT = 0
Debug.Print
Debug.Print "TEST1 Summary (cycles count: " & NC & ", sub-cycles: " & N & ")"
For C = 1 To NC
  TT0 = GetTickCount()
  For I = 1 To N
    S = GenerateKeyPhrase()
  Next I
  T = (GetTickCount() - TT0)
  Debug.Print "    Pass " & C & ", ticks: " & T
  TT = TT + T
Next C
TTA = TT / NC
Debug.Print "    -------------"
Debug.Print "    Total ticks: " & TT
Debug.Print "    Avg. ticks:  " & TTA
End Sub

Private Sub Test2()
Dim TT0 As Long, TT As Long, TTA As Long, T As Long
Dim C As Long, I As Long, S As String
Const N As Long = 10000, NC As Long = 5
TT = 0
Debug.Print
Debug.Print "TEST2 Summary (cycles count: " & NC & ", sub-cycles: " & N & ")"
For C = 1 To NC
  TT0 = GetTickCount()
  For I = 1 To N
    S = StringGenerate()
  Next I
  T = (GetTickCount() - TT0)
  Debug.Print "    Pass " & C & ", ticks: " & T
  TT = TT + T
Next C
TTA = TT / NC
Debug.Print "    -------------"
Debug.Print "    Total ticks: " & TT
Debug.Print "    Avg. ticks:  " & TTA
End Sub

Private Sub Command1_Click()
Test1
Test2
End Sub


Результаты на моей машине:

Код: Выделить всё

TEST1 Summary (cycles count: 5, sub-cycles: 10000)
    Pass 1, ticks: 1187
    Pass 2, ticks: 1172
    Pass 3, ticks: 1188
    Pass 4, ticks: 1172
    Pass 5, ticks: 1187
    -------------
    Total ticks: 5906
    Avg. ticks:  1181

TEST2 Summary (cycles count: 5, sub-cycles: 10000)
    Pass 1, ticks: 672
    Pass 2, ticks: 688
    Pass 3, ticks: 671
    Pass 4, ticks: 688
    Pass 5, ticks: 672
    -------------
    Total ticks: 3391
    Avg. ticks:  678


Разница в полсекунды на десять тысяч вызовов помоему не принципиальна.

[TEH3OP]

Ты учти, что RND дает не случайное число, а ПСЕВДОСЛУЧАЙНОЕ. И если знать алгоритм его формирования, можно подобрать такое значение Randomize, что данная ситуация как-раз и возникнет.

Ты же сам сказал, что этим никто не будет заниматься! Проще крякнуть и/или выложить халявный ключь!

Вероятность, что 1000 раз подряд будет выпадать числа в диапазоне 0...31 равна (примерно) 8.128548625558E-904, но дело не в вероятности, а в принципиальной возможности такой ситуации. Мало ли, может математический сопроцессор глюк словит и всегда будет RND()=0.

Согласен.
Но, глюки проца, это уже не наша проблемма.
А если уж исключать принцыпиальную возможность, то можно Do ... Loop заменить на For ... Next с Exit For и вслучае выхода по завершению цикла, выдавать ошибку.

Насчет твоего доработанного варианта - а теперь сравни его с моим? И еще учти, что константы cLetter и прочие можно использовать в других целях (у меня, к примеру, они используются для орфографического анализа), т.е. их можно исключить из листинга.

Сравнил... Вот тебе ещё мой вариант, твоего варианта -- сравни...

Код: Выделить всё

Function GenerateKeyPhrase(Optional ByVal PhraseLength As Long) As String
    Dim res As String, I As Long, C As Byte, S As String, N As Long, TMP As Long
    If PhraseLength = 0 Then
        Randomize
        PhraseLength = 20 + Rnd * 20
    End If
    Randomize
    TMP = 1 + Rnd * 2
    Select Case TMP
        Case 1
            S = cRLetter
        Case 2
            S = cLLetter
        Case 3
            S = cDigits
    End Select
   
    For I = 1& To PhraseLength
        TMP = Len(S) - 1&
        C = 1 + Rnd * TMP
        N = N + 1&
        If N >= Rnd * 10 And N > 1& Then
            C = 0
            N = 0&
            Randomize
            If Rnd > 0.5! Then
                S = cRLetter
            Else
                S = cLLetter
            End If
           
            If Rnd < 0.25! Then
                S = S & cDigits
            End If
        End If
       
        If C = 0 Then
            res = res & vbSpace
        Else
            If N = 1& Then
                S = Mid$(S, C, 1)
                res = res & UCase$(S)
            Else
                S = Mid$(S, C, 1)
                res = res & LCase$(S)
            End If
        End If
    Next I
    GenerateKeyPhrase = res
End Function


... и всёравно у меня быстрее. Ж8-D

А вот константы из листинга ненадо исключать, если они юзаются -- должны быть, а то что они ещё где-то используются, так это ПЛОХО!

И вообще, лучше объясняться фактами.
Разница в полсекунды на десять тысяч вызовов помоему не принципиальна.

1) Такие вещи "достовернее" запускать скомпилёнными (если что -- заменить Debug.Print на Me.Print).
2) У меня длина строки в интервале (10;50), а у тебя (20;40).
2) Тут не просто полсекунды, а моё в два раза быстрее работает. ;-)

[alibek]

А вот константы из листинга ненадо исключать, если они юзаются -- должны быть, а то что они ещё где-то используются, так это ПЛОХО!

А чем плохо? Неужели ты не используешь vbNewLine, vbTab, а в каждой процедуре определяешь свои константы?

А что касается того, на полсекунды быстрее или в два раза, все зависит от задачи. Если генерация ключа является основной задачей программы и она этим занимается все время, пока запущена, то да, это в два раза быстрее.
Но если ключ генерируется лишь время от времени, по команде пользователя, это не в два раза, а на полсекунды меньше.

Лучше так, выражу алгоритм словами.

У меня:
Выбирается строка, содержащая допустимые для ключа символы. Из этой строки выбирается случайный символ, этот символ добавляется к ключу. Повторяется столько раз, сколько нужно символов в ключе.


У тебя:
Генерируется случайный символ. Проверяется, соответствует ли он допустимому диапазону? Если нет, то цикл повторяется. Если соответствует, то символ добавляется к ключу. Повторяется столько раз, сколько нужно символов в ключе.

Видишь разницу?

[TEH3OP]

А вот константы из листинга ненадо исключать, если они юзаются -- должны быть, а то что они ещё где-то используются, так это ПЛОХО!

А чем плохо? Неужели ты не используешь vbNewLine, vbTab, а в каждой процедуре определяешь свои константы?

Хм... я слишком категорично выразился. Тут у тебя константы используются в двух различных по концепциям задачах -- ЭТО ПЛЁХО!
Ю аск ме вай? ;-)
Если ты захочешь чё-нить поменять (например захочешь изменить диапазон символов, которые изпользуются при генерации кода), то у тебя могут сказать "КРЯ", другие функции, использующие данные константы. В крупных проектах такое бывает... поверь мне!!! ;-)

Сие не относится к общим константам, но их общие надо делать осторожно, не оч. много и имена им давать такие, чтобы они выделялись из частных.

А что касается того, на полсекунды быстрее или в два раза, все зависит от задачи. Если генерация ключа является основной задачей программы и она этим занимается все время, пока запущена, то да, это в два раза быстрее.
Но если ключ генерируется лишь время от времени, по команде пользователя, это не в два раза, а на полсекунды меньше.

Согласен! Всё в мире относительно... но...

Лучше так, выражу алгоритм словами.

У меня:
Выбирается строка, содержащая допустимые для ключа символы. Из этой строки выбирается случайный символ, этот символ добавляется к ключу. Повторяется столько раз, сколько нужно символов в ключе.

У тебя:
Генерируется случайный символ. Проверяется, соответствует ли он допустимому диапазону? Если нет, то цикл повторяется. Если соответствует, то символ добавляется к ключу. Повторяется столько раз, сколько нужно символов в ключе.

Видишь разницу?

Ой! "Зачем ж я, Бурёнка, тебя продаю!"

Вот типа "коммерческий вариант":

Код: Выделить всё

Const ERROR_INVALID_PROCEDURE_CALL As Long = 5&

'Генерирует строку из символов с кодами, заключёнными в заданых интервалах.
'   iMinLen - минимальная длина генерируемой строки.
'   iMaxLen - максимальная длина генерируемой строки.
'   iRanges - массив с значениями интервалов. Читается так: каждый чётный элемент
'             массива - начало интервала, а каждый нечётный - конец. Массив должен
'             базироваться на нуле.
Public Function StringGenerate(ByVal iMinLen As Long, _
                               ByVal iMaxLen As Long, _
                               ByRef iRanges() As Byte) As String
Public Const MAX_CHAR As Byte = 255
   
    Dim bstReturn As String
    Dim lngLen As Long
    Dim lngRangesCount As Long
    Dim lngCurRangeIdx As Long
    Dim bytCurChar As Byte
    Dim k As Long
    Dim abytRanges() As Byte
    Dim lngTMP As Long
   
    'Проверка параметров.
    'Массив с значениями интервалов должен базироваться на нуле.
    If LBound(iRanges) <> 0& Then
        Err.Raise ERROR_INVALID_PROCEDURE_CALL
    End If
   
    abytRanges() = iRanges
    lngRangesCount = UBound(abytRanges)
           
    'Проверка параметров.
    'Начало каждого интервала должно быть меньше конца.
    For k = 0& To lngRangesCount
        'Это чётная итерация?
        If k And 1 Then
        '[Нет.]
            'Сравним начало и конец интервала.
            'Начало интервала не должно быть больше конца.
            If abytRanges(lngTMP) > abytRanges(k) Then
                Err.Raise ERROR_INVALID_PROCEDURE_CALL
            End If
        Else
        '[Да.]
            'Запомним индекс чётного элемента.
            lngTMP = k
        End If
    Next k
           
    'Если в массиве нечётное число элементов, то значит
    'последний интервал уходит в "бесконечность".
    If Not lngRangesCount And 1& Then
        'Добавим ещё один элемент -- максимальное значение кода символа.
        lngRangesCount = lngRangesCount + 1&
        ReDim abytRanges(0 To lngRangesCount) As Byte
        abytRanges(lngRangesCount) = MAX_CHAR
    End If
   
    'Рассчитаем число интервалов.
    lngRangesCount = lngRangesCount \ 2&
    VBA.Randomize
       
    lngTMP = (iMaxLen - iMinLen)
    lngTMP = VBA.Rnd() * lngTMP
    lngLen = lngTMP + iMinLen
   
    Dim lngStartRangeIdx As Long
    Dim lngEndRangeIdx As Long
   
    'Бежим по всей длине результирующей строки.
    For k = 0& To lngLen
        'Выбираем интервал.
        lngCurRangeIdx = VBA.Rnd() * lngRangesCount
        'Рассчитываем индексы начала и конца.
        lngStartRangeIdx = lngCurRangeIdx * 2
        lngEndRangeIdx = lngCurRangeIdx * 2 + 1&
        'Формируем код очередного символа.
        bytCurChar = abytRanges(lngStartRangeIdx) + _
            VBA.Rnd() * (abytRanges(lngEndRangeIdx) - abytRanges(lngStartRangeIdx))
       
        bstReturn = bstReturn & VBA.Chr$(bytCurChar)
    Next k
   
    'Вернём результат.
    StringGenerate = bstReturn
End Function


[alibek]

Видимо ReDim Preserve abytRanges(0 To lngRangesCount) As Byte?
Это уже лучше, но! Чтобы передать массив, его нужно вначале объявить. Т.е. у тебя не получится просто задать

Код: Выделить всё

MsgBox StringGenerate(...)

а придется использовать нечто вроде

Код: Выделить всё

Dim aRanges() As Byte
ReDim Ranges(...)
aRanges(...) = ...
...
MsgBox StringGenerate(...)

Неудобно

[alibek]

Хм... я слишком категорично выразился. Тут у тебя константы используются в двух различных по концепциям задачах -- ЭТО ПЛЁХО!

Нет. Эти константы не используются для генерации пароля. Эти константы определяют список букв, цифр и т.п. И они не будут менять свое значение. Это ключ всегда будет состоять из смеси букв и цифр.

[TEH3OP]

Видимо ReDim Preserve abytRanges(0 To lngRangesCount) As Byte?
Это уже лучше, но!

Опа, лоханулся!
Ну так релизную версию завсегда приятно обмыть и пропатчить! ;-)
Кстати, там ещё нет проверки "iMaxLen >= iMinLen".

Чтобы передать массив, его нужно вначале объявить. Т.е. у тебя не получится просто задать

Код: Выделить всё

MsgBox StringGenerate(...)

А что тут плохого? Массив можно на уровне модуля объявить -- ОДИН РАЗ.
Можно конечно массив как Variant принимать, но это едрёно замедлит работу процедуры из за раздувания проверки и инкапсуляции оного параметра.

а придется использовать нечто вроде

Код: Выделить всё

Dim aRanges() As Byte
ReDim Ranges(...)
aRanges(...) = ...
...
MsgBox StringGenerate(...)

Неудобно :)

ReDim не надо! Достаточно

Код: Выделить всё

Dim abytRanges(1) as Byte
abytRanges(0) = 31
abytRanges(1) = 255
VBA.MsgBox(StringGenerate(10, 20, abytRanges)


Чего тут неудобного???
Не придирайтесь да не придраны будете! Ж8-)