[AccessD] Unlock/Unprotect VBA Project
Stuart McLachlan
stuart at lexacorp.com.pg
Fri Jun 1 15:49:46 CDT 2018
Good find!
On 1 Jun 2018 at 15:44, Gustav Brock wrote:
> Hi Stuart et al
>
> I found this which uses the advapi32.dll (32/64) to create any of all
> the common hash methods:
>
> https://gist.github.com/jermity/b81622a2b10449c6be99
>
> Code module only:
>
> https://gist.githubusercontent.com/jermity/b12e26bc1adb38840099/raw/vb
> a_advapi32_64-bit.vb
>
> The SHA1 function returns the same output as that of Stuart's.
>
> /gustav
>
> -----Oprindelig meddelelse-----
> Fra: AccessD [mailto:accessd-bounces at databaseadvisors.com] På vegne af
> Stuart McLachlan Sendt: 8. maj 2018 02:39 Til: Access Developers
> discussion and problem solving <accessd at databaseadvisors.com> Emne:
> Re: [AccessD] Unlock/Unprotect VBA Project
>
> On 7 May 2018 at 19:24, Bill Benson wrote:
>
> > As for dealing with hashes in general, I know nothing of how to do
> > that.
>
>
> A bit of plug-and-play boilerplate for storing passwords with SHA1 See
> https://tools.ietf.org/html/rfc3174
>
> While it's not the most secure of hashes and you will see internet
> alarmism about it being broken and not to use it, it's more than
> secure enough for most purposes.
>
>
> Save credentials:
> Currentdb.Execute "Insert into tblUsers (Username,PW) Values ('" &
> txtUsername & "','" & hashstring(txtPassword) & "');"
>
> Validate credentials:
>
> If hashstring(txtPassword) <> DLookup("PW","tblUsers","Username = '"
> & txtusername & "'") then Msgbox "Invalid username or password!"
>
> The Hashstring stored and compared will always be a 40 hex character
> string.
>
> It would take a determined hacker a looong time to find out what
> password to enter to match the stored PW value:
> 3ED8250971CC5F536E7FD7E086EE7EA970896CEB
>
>
> modCrypto (watch for wordwrap)
>
> Option Explicit
> Option Compare Database
>
> 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 hashString(str As String) As String
> Dim B() As Byte
> B = StrConv(str, vbFromUnicode)
> hashString = HexDefaultSHA1(B)
> End Function
>
> 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
>
> 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)
>
> 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 - 8) 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 = "0000000000000000000000000000000000000000"
> H = Hex(H1): L = Len(H): Mid(DecToHex5, 9 - L, L) = H
> H = Hex(H2): L = Len(H): Mid(DecToHex5, 17 - L, L) = H
> H = Hex(H3): L = Len(H): Mid(DecToHex5, 25 - L, L) = H
> H = Hex(H4): L = Len(H): Mid(DecToHex5, 33 - L, L) = H
> H = Hex(H5): L = Len(H): Mid(DecToHex5, 41 - L, L) = H
> End Function
>
> --
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>
More information about the AccessD
mailing list