[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