[AccessD] Unlock/Unprotect VBA Project

Rocky Smolin rockysmolin at bchacc.com
Sat Jun 2 17:21:32 CDT 2018


But are you working with applications that require that level of security?

r

-----Original Message-----
From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Bill Benson
Sent: Saturday, June 02, 2018 1:20 PM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] Unlock/Unprotect VBA Project

I just wish I understood better what this does, how to incorporate it into
my applications. I'll just have to study the links. The whole notion of
hashes has eluded me every time I have tried to understand it. Just a
severe mental block. I am probably not a serious computer programmer, just
a power user of Excel who learned to write macros in his spare time.
Encryption, hashes, etc just never got through to me because I didn't get
into "hacking" early in life mayne.

On Sat, Jun 2, 2018, 2:33 PM Jim Lawrence <accessd at shaw.ca> wrote:

> Brilliant, Gustav...I will squirrel this away for future reference.
>
> Jim
>
> ----- Original Message -----
> From: "Gustav Brock" <gustav at cactus.dk>
> To: "Access Developers discussion and problem solving" <
> accessd at databaseadvisors.com>
> Sent: Friday, June 1, 2018 8:44:14 AM
> Subject: Re: [AccessD] Unlock/Unprotect VBA Project
>
> 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/vba_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
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>
-- 
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