VBA генерирует случайную уникальную строку альфа-цифры c - PullRequest
Новая
       203

VBA генерирует случайную уникальную строку альфа-цифры c

0 голосов
/ 12 февраля 2020

Мне нужно создать уникальный идентификатор (строку) для каждой записи, так как я разрабатываю приложение, которое позволяет пользователям получать доступ к уникальному URL-адресу, например:

http://URL.com/BXD31F

Приведенный ниже код работает для создания URLID: 

Public Function getURLID(ID As Double) As String

Randomize
Dim rgch As String
rgch = "23456789ABCDEFGHJKLMNPQRSTUVWXYZ"

Dim i As Long
For i = 1 To 5
    getURLID = getURLID & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
Next

End Function

Как я могу убедиться, что созданный URLID уникален? Нужно ли запрашивать базу данных, чтобы убедиться, что она не была сгенерирована раньше? В таблице 5 миллионов записей. Запрос dlookup превысил бы ограничения моей базы данных MSAccess.

Я рассмотрел использование временной строки для генерации URLID: 

 Format(Now, "yymmddhhmmss")

Однако мне нужна только простая строка из 5 символов.

Ответы [ 3 ]

2 голосов
/ 12 февраля 2020

Как я могу убедиться, что созданный URLID уникален?

Вы не можете. И этого не будет. Изучите криптографически безопасные алгоритмы хеширования ... и даже эти никогда не будут "безопасными" вечно. Обратите внимание, что для хэширования VBA имеет абсолютно нулевую встроенную поддержку, но вы можете использовать. NET для этого .

Другой вариант - заставить ОС генерировать глобально уникальные идентификаторы (GUID) ; эти будут уникальными, ... но гораздо дольше, чем несколько символов.

Удачи!

1 голос
/ 12 февраля 2020

Обеспечение уникальности строки в VBA может быть сделано как-то иначе. Например, возьмите время даты, которое уникально каждую секунду, и дайте ему: 

format(now, "YYMMDDHHNS")

Насколько это было бы слишком очевидно, рассмотрите возможность его изменения. Например, удалите случайное число от даты и времени, скажем, 181387 (так как это простое число) и передайте его в шестнадцатеричное число. Тогда это было бы вполне нормально: 

Function UniqueString() As String

    Const someNumber = 181387 'it is a prime number
    UniqueString = Hex(Format(Now, "YYMMDDHHNS") - someNumber)

End Function

Вышеуказанное не работает для 32-разрядных машин. Таким образом, вы можете рассмотреть возможность разделения частей даты на отдельные числа и их шестнадцатеричное разделение по отдельности: 

Function UniqueString32() As String

    Const primeNumber = 23        
    Application.Wait Now + #12:00:02 AM#    'waiting 2 seconds
    UniqueString32 = Hex(Format(Now, "YY")) _
                    & Hex(Format(Now, "MM")) _
                    & Hex(Format(Now, "DD")) _
                    & Hex(Format(Now, "HH")) _
                    & Hex(Format(Now, "NS") - primeNumber)

End Function

Просто убедитесь, что есть хотя бы 1 секунда перед вызовом функции, вызывая ее одновременно зона. Кроме того, неплохо бы заранее подумать о переходе на летнее время. В общем, это не очень хорошая идея, будет довольно много проблем, но для и все будет в порядке.

0 голосов
/ 19 февраля 2020

Мне удалось решить собственную проблему. Нам нужно проверить, существует ли уже URLID в таблице. Проблема в том, что URLID не записывается в таблицу до тех пор, пока запрос не будет полностью выполнен. Использование 6 из 24 возможных символов даст нам около 191 миллиона возможностей (от 24 до 6). Поскольку нам нужно всего лишь создать 5 миллионов идентификаторов, существует небольшая вероятность дублирования записей.

Вот как я это сделал:

Шаг 1 - Генерация случайного URLID для 5 миллионов строк используя исходный код

Шаг 2 - Определите дубликаты и обновите их до нулевого значения, используя запрос ниже 

 UPDATE URLIDs SET URLIDs.URL = Null
 WHERE (((URLIDs.URL) In (SELECT [URL] FROM [URLIDs] As Tmp GROUP BY [URL] HAVING 
 Count(*)>1 )));

Шаг 3 - Создайте новый URLID для нулей, определенных на шаге 2. На этот раз, проверяя посмотреть, если они уже существуют в таблице. См. Код ниже: 

Public Function getURLID(roll As Double) As String
Randomize
Dim rgch As String
rgch = "ABCDEFGHJKLMNPQRSTUVWXYZ"
Dim i As Long

For i = 1 To 6
        getURLID = getURLID & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
Next

Do Until URLIDExists(getURLID) = False
    getURLID = ""

    For i = 1 To 6
        getURLID = getURLID & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
    Next
Loop
End Function

Функция ниже используется для проверки, существует ли URL 

Public Function URLIDExists(URLID As String) As Boolean
Dim RS1
Dim strQuery As String
strQuery = "SELECT * from [URLIDs] where [URL]='" & URLID & "'"
Set RS1 = CurrentDb.OpenRecordset(strQuery)
If RS1.RecordCount > 0 Then
URLIDExists = True
Else
URLIDExists = False
End If
Set RS1 = Nothing
End Function

Я повторял шаги 2 и 3, пока больше не было дубликатов. Каждый раз проверяется наличие уже подтвержденного URLID. В конце концов больше не будет дубликатов URLID.

...