Страницы: 1
RSS
VBA уникальный hash текстового шаблона
 
Всем привет
Есть текстовые шаблоны, состоящие из простыни текста. Нам нужно на основе этого текста, сгенерировать hash чтобы использовать его как ID. Посоветуйте пожалуйста, какой hash лучше генерировать? Почему спрашиваю, если мысли про md5, sha1, guid может что-то еще предложат коллеги! Благодарю за помощь!  
 
Всеволод, а поискать то почему не пробовали? Для Power Query, ну, да нет ничего, а для VBA-то - вагони маленькая тележка.
 
Цитата
Андрей VG написал:
а поискать то почему не пробовали?
С этим проблема: вот и Дима здесь интересуется )
 
Андрей VG, вариантов создания hash в VBA действительно много.
Цитата
Посоветуйте пожалуйста, какой hash лучше генерировать?
Ключевой вопрос был, какой "лучше", "правильней". Вы часто советуете настолько интересные решения, что я решим уточнить.
Если по сути без разницы, то заюзаю md5
 
Цитата
Vsevolod написал:
какой "лучше", "правильней".
Из тех что по ссылке - любой. Если очень боитесь вдруг появления одного и того же хэша для разных строк, то sha512, но он самый большой по длине строки.
 
Проверенный вариант на "чистом" VBA. С совпадением хэша не сталкивались.
Код
Option Explicit

Private Type FourBytes
    A As Byte
    B As Byte
    C As Byte
    D As Byte
End Type
Private Type OneLong
    L As Long
End Type

Function HexDefaultSHA1(Message() As Byte) As String
 Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
 DefaultSHA1 Message, H1, H2, H3, H4, H5
 HexDefaultSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function

Function HexSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long) As String
 Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
 xSHA1 Message, Key1, Key2, Key3, Key4, H1, H2, H3, H4, H5
 HexSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function

Sub DefaultSHA1(Message() As Byte, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
 xSHA1 Message, &H5A827999, &H6ED9EBA1, &H8F1BBCDC, &HCA62C1D6, H1, H2, H3, H4, H5
End Sub

Sub xSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
 'CA62C1D68F1BBCDC6ED9EBA15A827999 + "abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
 '"abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"

 Dim U As Long, P As Long
 Dim FB As FourBytes, OL As OneLong
 Dim i As Integer
 Dim w(80) As Long
 Dim A As Long, B As Long, C As Long, D As Long, E As Long
 Dim T As Long

 H1 = &H67452301: H2 = &HEFCDAB89: H3 = &H98BADCFE: H4 = &H10325476: H5 = &HC3D2E1F0

 U = UBound(Message) + 1: OL.L = U32ShiftLeft3(U): A = U \ &H20000000: LSet FB = OL 'U32ShiftRight29(U)

 ReDim Preserve Message(0 To (U + 8 And -64) + 63)
 Message(U) = 128

 U = UBound(Message)
 Message(U - 4) = A
 Message(U - 3) = FB.D
 Message(U - 2) = FB.C
 Message(U - 1) = FB.B
 Message(U) = FB.A

 While P < U
     For i = 0 To 15
         FB.D = Message(P)
         FB.C = Message(P + 1)
         FB.B = Message(P + 2)
         FB.A = Message(P + 3)
         LSet OL = FB
         w(i) = OL.L
         P = P + 4
     Next i

     For i = 16 To 79
         w(i) = U32RotateLeft1(w(i - 3) Xor w(i -  Xor w(i - 14) Xor w(i - 16))
     Next i

     A = H1: B = H2: C = H3: D = H4: E = H5

     For i = 0 To 19
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), w(i)), Key1), ((B And C) Or ((Not B) And D)))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i
     For i = 20 To 39
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), w(i)), Key2), (B Xor C Xor D))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i
     For i = 40 To 59
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), w(i)), Key3), ((B And C) Or (B And D) Or (C And D)))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i
     For i = 60 To 79
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), w(i)), Key4), (B Xor C Xor D))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i

     H1 = U32Add(H1, A): H2 = U32Add(H2, B): H3 = U32Add(H3, C): H4 = U32Add(H4, D): H5 = U32Add(H5, E)
 Wend
End Sub

Function U32Add(ByVal A As Long, ByVal B As Long) As Long
 If (A Xor B) < 0 Then
     U32Add = A + B
 Else
     U32Add = (A Xor &H80000000) + B Xor &H80000000
 End If
End Function

Function U32ShiftLeft3(ByVal A As Long) As Long
 U32ShiftLeft3 = (A And &HFFFFFFF) * 8
 If A And &H10000000 Then U32ShiftLeft3 = U32ShiftLeft3 Or &H80000000
End Function

Function U32ShiftRight29(ByVal A As Long) As Long
 U32ShiftRight29 = (A And &HE0000000) \ &H20000000 And 7
End Function

Function U32RotateLeft1(ByVal A As Long) As Long
 U32RotateLeft1 = (A And &H3FFFFFFF) * 2
 If A And &H40000000 Then U32RotateLeft1 = U32RotateLeft1 Or &H80000000
 If A And &H80000000 Then U32RotateLeft1 = U32RotateLeft1 Or 1
End Function
Function U32RotateLeft5(ByVal A As Long) As Long
 U32RotateLeft5 = (A And &H3FFFFFF) * 32 Or (A And &HF8000000) \ &H8000000 And 31
 If A And &H4000000 Then U32RotateLeft5 = U32RotateLeft5 Or &H80000000
End Function
Function U32RotateLeft30(ByVal A As Long) As Long
 U32RotateLeft30 = (A And 1) * &H40000000 Or (A And &HFFFC) \ 4 And &H3FFFFFFF
 If A And 2 Then U32RotateLeft30 = U32RotateLeft30 Or &H80000000
End Function

Function DecToHex5(ByVal H1 As Long, ByVal H2 As Long, ByVal H3 As Long, ByVal H4 As Long, ByVal H5 As Long) As String
 Dim H As String, L As Long
 DecToHex5 = "00000000 00000000 00000000 00000000 00000000"
 H = Hex(H1): L = Len(H): Mid(DecToHex5, 9 - L, L) = H
 H = Hex(H2): L = Len(H): Mid(DecToHex5, 18 - L, L) = H
 H = Hex(H3): L = Len(H): Mid(DecToHex5, 27 - L, L) = H
 H = Hex(H4): L = Len(H): Mid(DecToHex5, 36 - L, L) = H
 H = Hex(H5): L = Len(H): Mid(DecToHex5, 45 - L, L) = H
End Function

' Convert the string into bytes so we can use the above functions
' From Chris Hulbert: http://splinter.com.au/blog
Public Function SHA1(str)
  Dim i As Long
  Dim arr() As Byte
  ReDim arr(0 To Len(str) - 1) As Byte
  For i = 0 To Len(str) - 1
   arr(i) = Asc(Mid(str, i + 1, 1))
  Next i
  SHA1 = Replace(UCase(HexDefaultSHA1(arr)), " ", "")
End Function
Изменено: sokol92 - 21.07.2018 14:11:05
Владимир
 
Добрый день, Владимир.
Спасибо за "нативный" вариант. Не делали вы, случайно, сравнение по скорости?
 
Цитата
Андрей VG написал:
Спасибо за "нативный" вариант
Здравствуйте, Андрей! Спасибо неизвестному мне австралийцу.  :)  Мы этой функцией пользуемся много лет для "цифровой подписи" при обмене данными.
Функция не быстрая (если сравнивать с C), 1 МБ текста шифруется за примерно 1 сек.
Код
Sub test()
  Dim txt1, txt2, t As Double, i As Long
  txt1 = Application.WorksheetFunction.Rept("ABCDEабвгд", 10) ' текст в 100 знаков
  t = Timer
  For i = 1 To 100000
   txt2 = SHA1(txt1)
  Next i
  Debug.Print Timer - t
End Sub

Off. Плюс в том, что этот метод определения хэша общеизвестен и есть практически на всех платформах. Например, для Oracle Pl/SQL аналогичная функция:
Код
  function GetHash(p_Text in varchar2) return varchar2 is
  begin
  return rawtohex(dbms_crypto.Hash(utl_raw.cast_to_raw(p_Text), dbms_crypto.HASH_SH1));
  end;
Изменено: sokol92 - 21.07.2018 16:59:57
Владимир
 
Андрей VG, Вы мне однажды подсказывали с функцией на javascript(Web Page) которую можно в PQ встроить. Все таки стоит выгружать результат в таблицу, через VBA генерировать хеш, потом обратно загружать и уже его использовать - или лучше на javascript?  
 
sokol92, приветствую, Владимир!
Вот ищу себе набор хэш-функции и тестирую… Так вот в коде из #6 ругается на строку №66
w(i) = U32RotateLeft1(w(i - 3) Xor w(i - Xor w(i - 14) Xor w(i - 16))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Думаю эта строка должна выглядеть вот так
Код
w(i) = U32RotateLeft1(w(i - 3) Xor w(i - 8 ) Xor w(i - 14) Xor w(i - 16))

P.S. 8 и скобку наш форум заменил на смайлик (а смайлик потом куда-то пропал)
Изменено: New - 01.10.2020 11:22:25
 
New, благодарю  ;)

UPD
Мне больше вот эта коллекция понравилась (с подключением библиотек) по скорости сравнимы с sokol_SHA1 в тесте из #8
Время по тесту, но на 10 000 элементов составляет от 0,5 до 2 сек (в зависимости от способа хэширования и вывода) при раннем связывании (подключены библиотеки «mscorlib.dll» и «msxml3.dll»)
Время sokol_SHA1 у меня составляет ~1,5 сек (на 10 000, а не на 100 000 элементов, как в тесте #8)
Модуль с функцией SHA1
Модуль коллекции с ссылками
Изменено: Jack Famous - 01.10.2020 13:02:35
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
sokol92, Владимир, хотел потестировать ваш код, но ДокторВеб выкидывает такие коленца...
«Бритва Оккама» или «Принцип Калашникова»?
 
Здравствуйте, Виталий! Увы, антивирусы часто (незаслуженно) доставляют проблемы макрописателям. :(  
Владимир
 
Цитата
sokol92 написал:
Функция не быстрая (если сравнивать с C)
Так и есть, замеры:
Владимир - 13,3671875 сек
32B77D7D80F2135D0C9A73EC95633159D0EDA6C6
Виталий - 0,578125 сек
32B77D7D80F2135D0C9A73EC95633159D0EDA6C6
Скрытый текст

Стало интересно, залил сегодня в свою библу новую функцию HashStringSHA(StringIn, VersionSHA)На исходниках Crypto++.
Поддержка следующих алгоритмов (+ новейшие SHA3) :
VersionSHA == 1, SHA1
VersionSHA == 2224, SHA2_224 hash
VersionSHA == 2256, SHA2_256 hash
VersionSHA == 2384, SHA2_384 hash
VersionSHA == 2512, SHA2_512 hash
VersionSHA == 3224, SHA3_224 hash
VersionSHA == 3256, SHA3_256 hash
VersionSHA == 3384, SHA3_384 hash
VersionSHA == 3512, SHA3_512 hash

Тест (выборочно, остальное можете протестировать сами):
SHA2_512 hash =  0,8984375 сек
SHA3_512 hash = 0,9296875

Прошу тестировать, исходники там же где и всегда BedvitXLL(v1.0.3.2beta).zip
«Бритва Оккама» или «Принцип Калашникова»?
 
bedvit, благодарствую))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Данная библиотека (Crypto++) поддерживает следующие hash functions: BLAKE2b, BLAKE2s, Keccack (F1600), SHA-1, SHA-2, SHA-3, SHAKE (128/256), SipHash, Tiger, RIPEMD (128/160/256/320), SM3, WHIRLPOOL.
+устаревшие: MD2, MD4, MD5, Panama Hash, DES, ARC4, SEAL 3.0, WAKE-OFB, DESX (DES-XEX3), RC2, SAFER, 3-WAY, GOST, SHARK, CAST-128, Square
Полный список по функционалу.
По запросу, могу добавить нужный функционал в свою библиотеку.
«Бритва Оккама» или «Принцип Калашникова»?
 
Цитата
sokol92 написал:
нативный
А не могли бы Вы привести пример, как использовать это?

Я просто, честно говоря, не делал ни разу.
На текущий момент у меня возникает для пользователя окно, в котором ему предлагается ввести пароль, а коде VBA он хранится напрямую и проиходит сравнение двух текстовых значений. А в этом случае, что должно храниться в коде?
Я так понял, что пользователь вводит пароль, он попадает в функцию, она выдаёт хеш и в код хранится хеш и происходит сравнение двух хешей. Так?

Может быть есть примерчик?

Спасибо.
 
Добрый день! Указанный сценарий возможен.
Обычно хэши используются для взаимодействия приложений, когда приложения шифруют по одному алгоритму один и тот же текст (включающий "секретную" часть) и сверяют хеш-коды (чтобы не передавать пароли по линиям связи). Если текст, например, включает текущую временную метку, то даже неоднократный перехват хэш-кода не приводит к раскрытию "секретной" части.
В рамках экземпляра Excel вряд ли стоит применять "тяжелую" артиллерию, поскольку исходный код макросов  защищен не надежно.
Изменено: sokol92 - 18.03.2021 15:15:56
Владимир
 
Доброго всем дня (ну или ночи...)
Обновил тут на днях компьютер, и столкнулся с бедой - не работает получение хэша MD5
Код
Private Function GetHash(ByVal txt$) As String 'MD5
    Dim oUTF8, oMD5, abyt, i&, k&, hi&, lo&, chHi$, chLo$
    Set oUTF8 = CreateObject("System.Text.UTF8Encoding")
    Set oMD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    abyt = oMD5.ComputeHash_2(oUTF8.GetBytes_4(txt$))
    For i = 1 To LenB(abyt)
        k = AscB(MidB(abyt, i, 1))
        lo = k Mod 16: hi = (k - lo) / 16
        If hi > 9 Then chHi = Chr(Asc("a") + hi - 10) Else chHi = Chr(Asc("0") + hi)
        If lo > 9 Then chLo = Chr(Asc("a") + lo - 10) Else chLo = Chr(Asc("0") + lo)
        GetHash = GetHash & chHi & chLo
    Next
    Set oUTF8 = Nothing: Set oMD5 = Nothing
End Function


Подскажите простую замену этого чем-нибудь нативным, без использования древнего .Net (вот именно потому что теперь новый и не пашет, так говорит интернет...), может есть какой класс не особо мудрёный, чтоб просто его добавить и использовать типа
Код
х = GetHash(строка$)
 
Hugo, Привет, Игорь. Сейчас попробовал твою функцию. Работает. Текст "строка" перевела в "4ca4dd3c5bffd076db2a618b5cad20e3". У меня Windows 10, Excel 2019, 64-bit.
На какой строке выдаёт ошибку? И "обновил компьютер" - это новый процессор поставил или что ?
Вот из этого ничего не подходит? https://en.wikibooks.org/wiki/Visual_Basic_for_Applications/String_Hashing_in_VBA­

P.S. А вот тут как прикрутить SHA-3 к VBA https://github.com/krijnsent/sha3_vba
Изменено: New - 30.03.2021 23:26:22
 
Hugo, приветствую! Чем не подошло мое решение? Просто установить или открыть надстройку и можно пользоваться как вы и хотели:
Код
txt2 = bCOM.HashStringSHA(txt1, 1)
Код не самописный, достаточно известная крипто-библиотека.
Изменено: bedvit - 31.03.2021 08:49:12
«Бритва Оккама» или «Принцип Калашникова»?
 
Добрый день! У Игоря на сайте есть пример "нативного" кода для MD5 (от Robert M. Hubley, 1999).
Изменено: sokol92 - 31.03.2021 13:31:33
Владимир
 
Цитата
New написал:
На какой строке выдаёт ошибку?
- на третьей, и это известная проблема, говорят This issue can be solved by installing the .NET Framework 3.5
"обновил компьютер" - от старого остались только видеокарта, память и один SATA шлейф... и 32 бита Эксель, но уже 365.
Цитата
bedvit написал:
Чем не подошло мое решение?
- да мне бы без надстройки, чтоб всё в файле было, мне людям нужно будет в файл внедрять. Там уже все с MD5 налажено, но вот боюсь что кто-то из них обновится и ага...
Цитата
sokol92 написал:
от Robert M. Hubley, 1999
- вот спасибо, думаю то что нужно пошёл внедрять :)
Изменено: Hugo - 31.03.2021 23:16:47
Страницы: 1
Наверх