SHA1 Hash

Prev: Drawing blended drop shadows quickly
Next: SetFocus to MDI Control

From: Steve on 11 May 2010 15:05

---

On May 11, 2:32 pm, Ulrich Korndoerfer
<ulrich_wants_nos...(a)prosource.de> wrote:
> Hi,
>
> If you are interested, I have an all VB Base64 converter, encapsulated
> in a class called CBase64. This class is embedded in the archive
> Cryptography.zip, available here:
>
> http://www.prosource.de/Downloads/VB_Quickies/Cryptography.zip
>
> And AFAIR Olafs RichClient.dll has a base64 converter too.
>
> --
> Ulrich Korndoerfer
>
> VB tips, helpers, solutions ->http://www.proSource.de/Downloads/

Thanks I am really greatful for all the help. However I have
determined the problem is not with the Base64 encoding. The simple
little function I was using is in fact doing the correct thing I just
am not passing it the data it expects. I have also been able to
verify that the SHA1 function itself is working correctly.

I found a pure vb implementation of alot of the .NET features called
VBCorLib (available here http://sourceforge.net/projects/vbcorlib/).
Using this code I was able to replicate what is done with the C#
code. Problem I am having now is in figuring out how to extract just
the code for the HMAC-SHA1 keyed hash (I can not include the entire
library as it is huge).

Anyway I think that what Olaf posted for me is really close but I
still have a few issues. As I say on the Base64 encoding I am having
a difficult time figuring out how to convert the hex string returned
by the SHA1 function I use into what is required by the encoding
code. I also am not sure the key is being added onto the data
correctly.

Thanks,
Steve

From: Steve on 11 May 2010 15:12

---

> What I suspect is that they just want your SHA1 serial key 'on file' so
> they can authenticate/validate your submissions to them. It doesn't
> matter what message string you use to create this serial key, and so
> the reason I posted the gibberish about embedding parts of your
> personal info so that it truly was unique to you. Otherwise, the
> message string you pass to the SHA1 function could have been "rumple
> stiltskin" for all intents and purposes.
>
> HTH
> Garry- Hide quoted text -
>
Well no, thats not it. The user (of my app) fills in a couple of
fields (Plan #, Claim #, and CSR). I would then take that entered
data add the Token value (what this is does not matter to this
conversation) and the date then calculate the HMAC-SHA1 keyed hash
using a shared secret key value. I would then build a URL from all
the pieces of data.
The resulting URL might look like this:
http://localhost:4162/admin/impersonate?plan=16263392&claim=3278053&csr=DA3&date=5/5/2010%2013:54&HASH=W8z0Ad5gLsIOYeGz3YnP1XQMapU=

Then when the code at the other end evaluates that URL it will use the
values embedded (with the shared secret key) to calculate a hash.
That calculated hash will then be compared with the one passed in the
URL...if they match then the request is valid and will be honored
otherwise it will not.

Steve

From: Schmidt on 11 May 2010 15:59

---

"Steve" <sredmyer(a)rfcorp.com> schrieb im Newsbeitrag
news:b8281c59-8c79-4011-aff1-bd2b65e49290(a)d27g2000yqc.googlegroups.com...

> I found a pure vb implementation of alot of the .NET features called
> VBCorLib (available here http://sourceforge.net/projects/vbcorlib/).
> Using this code I was able to replicate what is done with the C#
> code.

Sounds good.

> Problem I am having now is in figuring out how to extract just
> the code for the HMAC-SHA1 keyed hash (I can not include
> the entire library as it is huge).

In this case you perhaps find the following little class useful,
which I've "thrown together" now - just cleanup my
coding-style a bit, in case it does not match your taste... ;-)


First, the new Form-Democode, now replicates
the result of your second given example correctly:
W8z0Ad5gLsIOYeGz3YnP1XQMapU=

And for the Input-Values of your other given example,
the ones which (in your opinion) should deliver:
1QI77EFgZ+P0KEvHDtBCQi4Jw7A=
I get here:
MzFRObwYZoEvp1iQ/Xjx6GS2f9w=
But I'm near 100% sure, that the above result is the correct one -
would be good, if you check *all* the Input-Values you've
posted, if these really match with the ones, which delivered:
1QI77EFgZ+P0KEvHDtBCQi4Jw7A=
on your machine.


'***Into a Form (with a Command1-Button)
Option Explicit

Private Hash As New cHash


Private Sub Form_Load()
Dim i&, Key() As Byte

Debug.Print "Example 0: normal SHA1-HexOutput for a given string: abc"
Debug.Print "a9993e364706816aba3e25717850c26c9cd0d89d"
Debug.Print Hash.SHA1("abc", True); vbCrLf

'the next three examples are covering different inputs as described in:
'http://csrc.nist.gov/publications/fips/fips198/fips-198a.pdf

Debug.Print "Example 1: HMAC_SHA1-Output for a Key, 64 Bytes long..."
ReDim Key(0 To 63)
For i = 0 To 63: Key(i) = i: Next
Debug.Print "4f4ca3d5d68ba7cc0a1208c9c61e9c5da0403c0a"
Debug.Print Hash.HMAC_SHA1("Sample #1", Key, True); vbCrLf


Debug.Print "Example 2: HMAC_SHA1-Output for a Key, 20 Bytes long..."
Debug.Print "0922d3405faa3d194f82a45830737d5cc6c75d24"
Debug.Print Hash.HMAC_SHA1("Sample #2", "0123456789:;<=>?@ABC", True)
Debug.Print


Debug.Print "Example 3: HMAC_SHA1-Output for a Key, 100 Bytes long..."
ReDim Key(0 To 99)
For i = 0 To 15: Key(&H0 + i) = &H50 + i: Next
For i = 0 To 15: Key(&H10 + i) = &H60 + i: Next
For i = 0 To 15: Key(&H20 + i) = &H70 + i: Next
For i = 0 To 15: Key(&H30 + i) = &H80 + i: Next
For i = 0 To 15: Key(&H40 + i) = &H90 + i: Next
For i = 0 To 15: Key(&H50 + i) = &HA0 + i: Next
For i = 0 To 3: Key(&H60 + i) = &HB0 + i: Next
Debug.Print "bcf41eab8bb2d802f3d05caf7cb092ecf8d1a3aa"
Debug.Print Hash.HMAC_SHA1("Sample #3", Key, True); vbCrLf
End Sub

Private Sub Command1_Click()
Dim txtToken$, txtPlan$, txtClaim$, txtCSR$, txtDate$
Dim sharedSecretBytes() As Byte, stringToHash As String
Dim HMACResult() As Byte

sharedSecretBytes = StrConv("SharedSecretKeyStoredInConfig", _
vbFromUnicode)

txtPlan = "16263392"
txtClaim = "3278053"
txtCSR = "DA3"
txtToken = "56FCEFC9-579C-445E-9FD3-AFFD76C8619E"
txtDate = "5/5/2010 13:54"
stringToHash = txtPlan + txtClaim + txtCSR + txtToken + txtDate

HMACResult = Hash.HMAC_SHA1(stringToHash, sharedSecretBytes, False)
Debug.Print Hash.Base64Enc(HMACResult)


sharedSecretBytes = StrConv("", vbFromUnicode)

txtPlan = "15847812"
txtClaim = "3270278"
txtCSR = "DA3"
txtToken = "56FCEFC9-579C-445E-9FD3-AFFD76C8619E"
txtDate = "5/5/2010 13:54"
stringToHash = txtPlan + txtClaim + txtCSR + txtToken + txtDate

HMACResult = Hash.HMAC_SHA1(stringToHash, sharedSecretBytes, False)
Debug.Print Hash.Base64Enc(HMACResult)
End Sub



'***Into a Class, named cHash (also supporting Base64 now)
Option Explicit

Private Declare Sub RtlMoveMemory Lib "kernel32" _
(Dst As Any, Src As Any, ByVal LenBytes As Long)

Private Const CRYPT_STRING_BASE64 As Long = 1
Private Const CRYPT_VERIFYCONTEXT = &HF0000000
Private Const CRYPT_MACHINE_KEYSET = 32

Private Declare Function CryptBinaryToStringW Lib "crypt32" ( _
pbBinary As Any, _
ByVal cbBinary As Long, _
ByVal dwFlags As Long, _
ByVal pszString As Long, _
pcchString As Long) As Long

Private Declare Function CryptStringToBinaryW Lib "crypt32" ( _
ByVal pszString As Long, _
ByVal cchString As Long, _
ByVal dwFlags As Long, _
pbBinary As Any, _
pcbBinary As Long, _
pdwSkip As Any, _
pdwFlags As Any) As Long

Private Declare Function CryptAcquireContextW Lib "advapi32" ( _
ByRef phProv As Long, _
ByVal pszContainer As Long, _
ByVal pszProvider As Long, _
ByVal dwProvType As Long, _
ByVal dwFlags As Long) As Long

Private Declare Function CryptReleaseContext Lib "advapi32" ( _
ByVal hProv As Long, _
ByVal dwFlags As Long) As Long

Private Declare Function CryptCreateHash Lib "advapi32" ( _
ByVal hProv As Long, _
ByVal Algid As Long, _
ByVal hKey As Long, _
ByVal dwFlags As Long, _
ByRef phHash As Long) As Long

Private Declare Function CryptDestroyHash Lib "advapi32" ( _
ByVal hHash As Long) As Long

Private Declare Function CryptHashData Lib "advapi32" ( _
ByVal hHash As Long, _
pbData As Any, _
ByVal dwDataLen As Long, _
ByVal dwFlags As Long) As Long

Private Declare Function CryptGetHashParam Lib "advapi32" ( _
ByVal hHash As Long, _
ByVal dwParam As Long, _
pbData As Any, _
pdwDataLen As Long, _
ByVal dwFlags As Long) As Long

Private Const PROV_RSA_FULL = 1
Private Const PROV_RSA_AES = 24

Private Const ALG_CLASS_HASH = 32768

Private Const ALG_TYPE_ANY = 0
Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4
Private Const ALG_SID_SHA_256 = 12
Private Const ALG_SID_SHA_384 = 13
Private Const ALG_SID_SHA_512 = 14

Private Enum HashAlgorithm
CALG_MD2 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2)
CALG_MD4 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4)
CALG_MD5 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
CALG_SHA1 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1)
CALG_SHA256 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256)
CALG_SHA384 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_384)
CALG_SHA512 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_512)
End Enum

Private Const HP_HASHVAL = 2
Private Const HP_HASHSIZE = 4


Public Function Base64Enc(Data) As String
Dim B() As Byte, BLen As Long, SLen As Long

If VarType(Data) = vbString Then
B = StrConv(Data, vbFromUnicode)
Else
B = Data
End If
BLen = UBound(B) - LBound(B) + 1

CryptBinaryToStringW B(LBound(B)), BLen, CRYPT_STRING_BASE64, 0, SLen

Base64Enc = Space$(SLen)
CryptBinaryToStringW B(LBound(B)), BLen, CRYPT_STRING_BASE64, _
StrPtr(Base64Enc), SLen

Base64Enc = Left$(Base64Enc, SLen - 2) 'cut off the vbCrLf at the end
End Function

Public Function Base64Dec(Base64Str As String, _
Optional ByVal AsByteArr As Boolean)
Dim B() As Byte, OutLen As Long

CryptStringToBinaryW StrPtr(Base64Str), Len(Base64Str), _
CRYPT_STRING_BASE64, ByVal 0&, OutLen, ByVal 0&, ByVal 0&

B = vbNullString
If OutLen Then
ReDim B(OutLen - 1)
CryptStringToBinaryW StrPtr(Base64Str), Len(Base64Str), _
CRYPT_STRING_BASE64, B(0), OutLen, ByVal 0&, ByVal 0&
End If

If AsByteArr Then
Base64Dec = B
Else
Base64Dec = StrConv(B, vbUnicode)
End If
End Function

Public Function SHA1(Message, Optional ByVal AsHexStr As Boolean)
Dim Msg() As Byte
If VarType(Message) = vbString Then
Msg = StrConv(Message, vbFromUnicode)
Else
Msg = Message
End If
SHA1 = Hash(Msg, CALG_SHA1, AsHexStr)
End Function

Public Function SHA256(Message, Optional ByVal AsHexStr As Boolean)
Dim Msg() As Byte
If VarType(Message) = vbString Then
Msg = StrConv(Message, vbFromUnicode)
Else
Msg = Message
End If
SHA256 = Hash(Msg, CALG_SHA256, AsHexStr)
End Function

Public Function MD5(Message, Optional ByVal AsHexStr As Boolean)
Dim Msg() As Byte
If VarType(Message) = vbString Then
Msg = StrConv(Message, vbFromUnicode)
Else
Msg = Message
End If
MD5 = Hash(Msg, CALG_MD5, AsHexStr)
End Function

Public Function HMAC_SHA1(Message, Key, Optional ByVal AsHexStr As Boolean)
Dim M() As Byte, K() As Byte
If VarType(Message) = vbString Then
M = StrConv(Message, vbFromUnicode)
Else 'we assume a byte-array now, and provoce an error, if it isn't one
M = Message
End If

If VarType(Key) = vbString Then
K = StrConv(Key, vbFromUnicode)
Else 'we assume a byte-array now, and provoce an error, if it isn't one
K = Key
End If

HMAC_SHA1 = HMAC(M, K, CALG_SHA1, AsHexStr)
End Function

Public Function HMAC_MD5(Message, Key, Optional ByVal AsHexStr As Boolean)
Dim M() As Byte, K() As Byte
If VarType(Message) = vbString Then
M = StrConv(Message, vbFromUnicode)
Else 'we assume a byte-array now, and provoce an error, if it isn't one
M = Message
End If

If VarType(Key) = vbString Then
K = StrConv(Key, vbFromUnicode)
Else 'we assume a byte-array now, and provoce an error, if it isn't one
K = Key
End If

HMAC_MD5 = HMAC(M, K, CALG_MD5, AsHexStr)
End Function

Private Function Hash(Msg() As Byte, ByVal Algo As HashAlgorithm, _
ByVal AsHexStr As Boolean)
Dim i As Long, hCtx As Long, hHash As Long, lLen As Long
Dim Prov As Long, Arr() As Byte

'PROV_RSA_AES is needed for SHA256 and above (needs a WinOS >= XP-SP3)
Prov = IIf(Algo > CALG_SHA1, PROV_RSA_AES, PROV_RSA_FULL)

If CryptAcquireContextW(hCtx, 0, 0, Prov, _
CRYPT_VERIFYCONTEXT Or CRYPT_MACHINE_KEYSET) Then

If CryptCreateHash(hCtx, Algo, 0, 0, hHash) Then

If CryptHashData(hHash, Msg(0), UBound(Msg) + 1, 0) Then

If CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0) Then

ReDim Arr(0 To lLen - 1) ' Initialize the buffer
If CryptGetHashParam(hHash, HP_HASHVAL, Arr(0), lLen, 0) Then

If AsHexStr Then
For i = 0 To UBound(Arr)
Hash = Hash & LCase$(Right$("0" & Hex$(Arr(i)), 2))
Next i
Else
Hash = Arr
End If

End If

End If

End If

CryptDestroyHash hHash ' Release the hash handle
End If

CryptReleaseContext hCtx, 0 ' Release the provider context
End If

If hCtx = 0 Then Err.Raise vbObjectError, , "Couldn't create Provider " _
& Hex(Err.LastDllError)
If hHash = 0 Then Err.Raise vbObjectError, , "Couldn't create HashHdl " _
& Hex(Err.LastDllError)
End Function


'this HMAC-subroutine currently supports only SHA1 and MD5-HMACS
'...in a "serious" implementation, one would code this part with
'the (already used within here) Win-Crypto-API-calls too
Private Function HMAC(M() As Byte, K() As Byte, _
ByVal Algo As HashAlgorithm, ByVal AsHexStr As Boolean)
Dim i&, LenKey&, oPAD() As Byte, iPad() As Byte, IntermHash() As Byte
Dim HashLen As Long
Select Case Algo
Case CALG_SHA1: HashLen = 20
Case CALG_MD5: HashLen = 16
End Select

ReDim oPAD(0 To 63 + HashLen) 'leave some space for IntermHash
ReDim iPad(0 To 63 + UBound(M) + 1) 'same here, but for the Msg-Content M

If UBound(K) + 1 > 64 Then 'Keys, longer than 64Bytes are shortened per
SHA1
K = Hash(K, Algo, False)
End If

LenKey = UBound(K) + 1

For i = 0 To 63 'ensure proper XORing on the first 64Bytes in oPad+iPad
oPAD(i) = &H5C
iPad(i) = &H36
If i < LenKey Then
oPAD(i) = oPAD(i) Xor K(i)
iPad(i) = iPad(i) Xor K(i)
End If
Next i

RtlMoveMemory iPad(64), M(0), UBound(M) + 1 'append Bytes of M to iPad...
IntermHash = Hash(iPad, Algo, False) '... and calculate IntermHash

RtlMoveMemory oPAD(64), IntermHash(0), HashLen 'append the result to oPad

HMAC = Hash(oPAD, Algo, AsHexStr) 'and give back the final HMAC
End Function


Olaf

From: GS on 11 May 2010 19:08

---

Steve presented the following explanation :
>> What I suspect is that they just want your SHA1 serial key 'on file' so
>> they can authenticate/validate your submissions to them. It doesn't
>> matter what message string you use to create this serial key, and so
>> the reason I posted the gibberish about embedding parts of your
>> personal info so that it truly was unique to you. Otherwise, the
>> message string you pass to the SHA1 function could have been "rumple
>> stiltskin" for all intents and purposes.
>>
>> HTH
>> Garry- Hide quoted text -
>>
> Well no, thats not it. The user (of my app) fills in a couple of
> fields (Plan #, Claim #, and CSR). I would then take that entered
> data add the Token value (what this is does not matter to this
> conversation) and the date then calculate the HMAC-SHA1 keyed hash
> using a shared secret key value. I would then build a URL from all
> the pieces of data.
> The resulting URL might look like this:
> http://localhost:4162/admin/impersonate?plan=16263392&claim=3278053&csr=DA3&date=5/5/2010%2013:54&HASH=W8z0Ad5gLsIOYeGz3YnP1XQMapU=
>
> Then when the code at the other end evaluates that URL it will use the
> values embedded (with the shared secret key) to calculate a hash.
> That calculated hash will then be compared with the one passed in the
> URL...if they match then the request is valid and will be honored
> otherwise it will not.
>
> Steve

Ok, I got it! So it's not just the serial returned by the hash that
your passing, and they aren't using that serial to authenticate your
URL. What you ARE doing is using HMACSHA1 along with a shared 'secret
key' so they can parse various data parts of the URL and use their
matching secret key to get a match for your Base64 encoded hash. Have I
got the jist of it right yet?

Olaf has done a great job of preparing a VB6 class to handle HMAC. I'm
at least glad to see that you're on your way to a solution. Sorry I
wasn't much help, but thank you for the learning experience!

Best of luck...
regards,
Garry

From: GS on 11 May 2010 19:16

---

Olaf, nice job. Thanks for sharing it with us!

Garry
--

After serious thinking Schmidt wrote :
> "Steve" <sredmyer(a)rfcorp.com> schrieb im Newsbeitrag
> news:b8281c59-8c79-4011-aff1-bd2b65e49290(a)d27g2000yqc.googlegroups.com...
>
>> I found a pure vb implementation of alot of the .NET features called
>> VBCorLib (available here http://sourceforge.net/projects/vbcorlib/).
>> Using this code I was able to replicate what is done with the C#
>> code.
>
> Sounds good.
>
>> Problem I am having now is in figuring out how to extract just
>> the code for the HMAC-SHA1 keyed hash (I can not include
>> the entire library as it is huge).
>
> In this case you perhaps find the following little class useful,
> which I've "thrown together" now - just cleanup my
> coding-style a bit, in case it does not match your taste... ;-)
>
>
> First, the new Form-Democode, now replicates
> the result of your second given example correctly:
> W8z0Ad5gLsIOYeGz3YnP1XQMapU=
>
> And for the Input-Values of your other given example,
> the ones which (in your opinion) should deliver:
> 1QI77EFgZ+P0KEvHDtBCQi4Jw7A=
> I get here:
> MzFRObwYZoEvp1iQ/Xjx6GS2f9w=
> But I'm near 100% sure, that the above result is the correct one -
> would be good, if you check *all* the Input-Values you've
> posted, if these really match with the ones, which delivered:
> 1QI77EFgZ+P0KEvHDtBCQi4Jw7A=
> on your machine.
>
>
> '***Into a Form (with a Command1-Button)
> Option Explicit
>
> Private Hash As New cHash
>
>
> Private Sub Form_Load()
> Dim i&, Key() As Byte
>
> Debug.Print "Example 0: normal SHA1-HexOutput for a given string: abc"
> Debug.Print "a9993e364706816aba3e25717850c26c9cd0d89d"
> Debug.Print Hash.SHA1("abc", True); vbCrLf
>
> 'the next three examples are covering different inputs as described in:
> 'http://csrc.nist.gov/publications/fips/fips198/fips-198a.pdf
>
> Debug.Print "Example 1: HMAC_SHA1-Output for a Key, 64 Bytes long..."
> ReDim Key(0 To 63)
> For i = 0 To 63: Key(i) = i: Next
> Debug.Print "4f4ca3d5d68ba7cc0a1208c9c61e9c5da0403c0a"
> Debug.Print Hash.HMAC_SHA1("Sample #1", Key, True); vbCrLf
>
>
> Debug.Print "Example 2: HMAC_SHA1-Output for a Key, 20 Bytes long..."
> Debug.Print "0922d3405faa3d194f82a45830737d5cc6c75d24"
> Debug.Print Hash.HMAC_SHA1("Sample #2", "0123456789:;<=>?@ABC", True)
> Debug.Print
>
>
> Debug.Print "Example 3: HMAC_SHA1-Output for a Key, 100 Bytes long..."
> ReDim Key(0 To 99)
> For i = 0 To 15: Key(&H0 + i) = &H50 + i: Next
> For i = 0 To 15: Key(&H10 + i) = &H60 + i: Next
> For i = 0 To 15: Key(&H20 + i) = &H70 + i: Next
> For i = 0 To 15: Key(&H30 + i) = &H80 + i: Next
> For i = 0 To 15: Key(&H40 + i) = &H90 + i: Next
> For i = 0 To 15: Key(&H50 + i) = &HA0 + i: Next
> For i = 0 To 3: Key(&H60 + i) = &HB0 + i: Next
> Debug.Print "bcf41eab8bb2d802f3d05caf7cb092ecf8d1a3aa"
> Debug.Print Hash.HMAC_SHA1("Sample #3", Key, True); vbCrLf
> End Sub
>
> Private Sub Command1_Click()
> Dim txtToken$, txtPlan$, txtClaim$, txtCSR$, txtDate$
> Dim sharedSecretBytes() As Byte, stringToHash As String
> Dim HMACResult() As Byte
>
> sharedSecretBytes = StrConv("SharedSecretKeyStoredInConfig", _
> vbFromUnicode)
>
> txtPlan = "16263392"
> txtClaim = "3278053"
> txtCSR = "DA3"
> txtToken = "56FCEFC9-579C-445E-9FD3-AFFD76C8619E"
> txtDate = "5/5/2010 13:54"
> stringToHash = txtPlan + txtClaim + txtCSR + txtToken + txtDate
>
> HMACResult = Hash.HMAC_SHA1(stringToHash, sharedSecretBytes, False)
> Debug.Print Hash.Base64Enc(HMACResult)
>
>
> sharedSecretBytes = StrConv("", vbFromUnicode)
>
> txtPlan = "15847812"
> txtClaim = "3270278"
> txtCSR = "DA3"
> txtToken = "56FCEFC9-579C-445E-9FD3-AFFD76C8619E"
> txtDate = "5/5/2010 13:54"
> stringToHash = txtPlan + txtClaim + txtCSR + txtToken + txtDate
>
> HMACResult = Hash.HMAC_SHA1(stringToHash, sharedSecretBytes, False)
> Debug.Print Hash.Base64Enc(HMACResult)
> End Sub
>
>
>
> '***Into a Class, named cHash (also supporting Base64 now)
> Option Explicit
>
> Private Declare Sub RtlMoveMemory Lib "kernel32" _
> (Dst As Any, Src As Any, ByVal LenBytes As Long)
>
> Private Const CRYPT_STRING_BASE64 As Long = 1
> Private Const CRYPT_VERIFYCONTEXT = &HF0000000
> Private Const CRYPT_MACHINE_KEYSET = 32
>
> Private Declare Function CryptBinaryToStringW Lib "crypt32" ( _
> pbBinary As Any, _
> ByVal cbBinary As Long, _
> ByVal dwFlags As Long, _
> ByVal pszString As Long, _
> pcchString As Long) As Long
>
> Private Declare Function CryptStringToBinaryW Lib "crypt32" ( _
> ByVal pszString As Long, _
> ByVal cchString As Long, _
> ByVal dwFlags As Long, _
> pbBinary As Any, _
> pcbBinary As Long, _
> pdwSkip As Any, _
> pdwFlags As Any) As Long
>
> Private Declare Function CryptAcquireContextW Lib "advapi32" ( _
> ByRef phProv As Long, _
> ByVal pszContainer As Long, _
> ByVal pszProvider As Long, _
> ByVal dwProvType As Long, _
> ByVal dwFlags As Long) As Long
>
> Private Declare Function CryptReleaseContext Lib "advapi32" ( _
> ByVal hProv As Long, _
> ByVal dwFlags As Long) As Long
>
> Private Declare Function CryptCreateHash Lib "advapi32" ( _
> ByVal hProv As Long, _
> ByVal Algid As Long, _
> ByVal hKey As Long, _
> ByVal dwFlags As Long, _
> ByRef phHash As Long) As Long
>
> Private Declare Function CryptDestroyHash Lib "advapi32" ( _
> ByVal hHash As Long) As Long
>
> Private Declare Function CryptHashData Lib "advapi32" ( _
> ByVal hHash As Long, _
> pbData As Any, _
> ByVal dwDataLen As Long, _
> ByVal dwFlags As Long) As Long
>
> Private Declare Function CryptGetHashParam Lib "advapi32" ( _
> ByVal hHash As Long, _
> ByVal dwParam As Long, _
> pbData As Any, _
> pdwDataLen As Long, _
> ByVal dwFlags As Long) As Long
>
> Private Const PROV_RSA_FULL = 1
> Private Const PROV_RSA_AES = 24
>
> Private Const ALG_CLASS_HASH = 32768
>
> Private Const ALG_TYPE_ANY = 0
> Private Const ALG_SID_MD2 = 1
> Private Const ALG_SID_MD4 = 2
> Private Const ALG_SID_MD5 = 3
> Private Const ALG_SID_SHA1 = 4
> Private Const ALG_SID_SHA_256 = 12
> Private Const ALG_SID_SHA_384 = 13
> Private Const ALG_SID_SHA_512 = 14
>
> Private Enum HashAlgorithm
> CALG_MD2 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2)
> CALG_MD4 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4)
> CALG_MD5 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
> CALG_SHA1 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1)
> CALG_SHA256 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256)
> CALG_SHA384 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_384)
> CALG_SHA512 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_512)
> End Enum
>
> Private Const HP_HASHVAL = 2
> Private Const HP_HASHSIZE = 4
>
>
> Public Function Base64Enc(Data) As String
> Dim B() As Byte, BLen As Long, SLen As Long
>
> If VarType(Data) = vbString Then
> B = StrConv(Data, vbFromUnicode)
> Else
> B = Data
> End If
> BLen = UBound(B) - LBound(B) + 1
>
> CryptBinaryToStringW B(LBound(B)), BLen, CRYPT_STRING_BASE64, 0, SLen
>
> Base64Enc = Space$(SLen)
> CryptBinaryToStringW B(LBound(B)), BLen, CRYPT_STRING_BASE64, _
> StrPtr(Base64Enc), SLen
>
> Base64Enc = Left$(Base64Enc, SLen - 2) 'cut off the vbCrLf at the end
> End Function
>
> Public Function Base64Dec(Base64Str As String, _
> Optional ByVal AsByteArr As Boolean)
> Dim B() As Byte, OutLen As Long
>
> CryptStringToBinaryW StrPtr(Base64Str), Len(Base64Str), _
> CRYPT_STRING_BASE64, ByVal 0&, OutLen, ByVal 0&, ByVal 0&
>
> B = vbNullString
> If OutLen Then
> ReDim B(OutLen - 1)
> CryptStringToBinaryW StrPtr(Base64Str), Len(Base64Str), _
> CRYPT_STRING_BASE64, B(0), OutLen, ByVal 0&, ByVal 0&
> End If
>
> If AsByteArr Then
> Base64Dec = B
> Else
> Base64Dec = StrConv(B, vbUnicode)
> End If
> End Function
>
> Public Function SHA1(Message, Optional ByVal AsHexStr As Boolean)
> Dim Msg() As Byte
> If VarType(Message) = vbString Then
> Msg = StrConv(Message, vbFromUnicode)
> Else
> Msg = Message
> End If
> SHA1 = Hash(Msg, CALG_SHA1, AsHexStr)
> End Function
>
> Public Function SHA256(Message, Optional ByVal AsHexStr As Boolean)
> Dim Msg() As Byte
> If VarType(Message) = vbString Then
> Msg = StrConv(Message, vbFromUnicode)
> Else
> Msg = Message
> End If
> SHA256 = Hash(Msg, CALG_SHA256, AsHexStr)
> End Function
>
> Public Function MD5(Message, Optional ByVal AsHexStr As Boolean)
> Dim Msg() As Byte
> If VarType(Message) = vbString Then
> Msg = StrConv(Message, vbFromUnicode)
> Else
> Msg = Message
> End If
> MD5 = Hash(Msg, CALG_MD5, AsHexStr)
> End Function
>
> Public Function HMAC_SHA1(Message, Key, Optional ByVal AsHexStr As Boolean)
> Dim M() As Byte, K() As Byte
> If VarType(Message) = vbString Then
> M = StrConv(Message, vbFromUnicode)
> Else 'we assume a byte-array now, and provoce an error, if it isn't one
> M = Message
> End If
>
> If VarType(Key) = vbString Then
> K = StrConv(Key, vbFromUnicode)
> Else 'we assume a byte-array now, and provoce an error, if it isn't one
> K = Key
> End If
>
> HMAC_SHA1 = HMAC(M, K, CALG_SHA1, AsHexStr)
> End Function
>
> Public Function HMAC_MD5(Message, Key, Optional ByVal AsHexStr As Boolean)
> Dim M() As Byte, K() As Byte
> If VarType(Message) = vbString Then
> M = StrConv(Message, vbFromUnicode)
> Else 'we assume a byte-array now, and provoce an error, if it isn't one
> M = Message
> End If
>
> If VarType(Key) = vbString Then
> K = StrConv(Key, vbFromUnicode)
> Else 'we assume a byte-array now, and provoce an error, if it isn't one
> K = Key
> End If
>
> HMAC_MD5 = HMAC(M, K, CALG_MD5, AsHexStr)
> End Function
>
> Private Function Hash(Msg() As Byte, ByVal Algo As HashAlgorithm, _
> ByVal AsHexStr As Boolean)
> Dim i As Long, hCtx As Long, hHash As Long, lLen As Long
> Dim Prov As Long, Arr() As Byte
>
> 'PROV_RSA_AES is needed for SHA256 and above (needs a WinOS >= XP-SP3)
> Prov = IIf(Algo > CALG_SHA1, PROV_RSA_AES, PROV_RSA_FULL)
>
> If CryptAcquireContextW(hCtx, 0, 0, Prov, _
> CRYPT_VERIFYCONTEXT Or CRYPT_MACHINE_KEYSET) Then
>
> If CryptCreateHash(hCtx, Algo, 0, 0, hHash) Then
>
> If CryptHashData(hHash, Msg(0), UBound(Msg) + 1, 0) Then
>
> If CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0) Then
>
> ReDim Arr(0 To lLen - 1) ' Initialize the buffer
> If CryptGetHashParam(hHash, HP_HASHVAL, Arr(0), lLen, 0) Then
>
> If AsHexStr Then
> For i = 0 To UBound(Arr)
> Hash = Hash & LCase$(Right$("0" & Hex$(Arr(i)), 2))
> Next i
> Else
> Hash = Arr
> End If
>
> End If
>
> End If
>
> End If
>
> CryptDestroyHash hHash ' Release the hash handle
> End If
>
> CryptReleaseContext hCtx, 0 ' Release the provider context
> End If
>
> If hCtx = 0 Then Err.Raise vbObjectError, , "Couldn't create Provider " _
> & Hex(Err.LastDllError)
> If hHash = 0 Then Err.Raise vbObjectError, , "Couldn't create HashHdl " _
> & Hex(Err.LastDllError)
> End Function
>
>
> 'this HMAC-subroutine currently supports only SHA1 and MD5-HMACS
> '...in a "serious" implementation, one would code this part with
> 'the (already used within here) Win-Crypto-API-calls too
> Private Function HMAC(M() As Byte, K() As Byte, _
> ByVal Algo As HashAlgorithm, ByVal AsHexStr As Boolean)
> Dim i&, LenKey&, oPAD() As Byte, iPad() As Byte, IntermHash() As Byte
> Dim HashLen As Long
> Select Case Algo
> Case CALG_SHA1: HashLen = 20
> Case CALG_MD5: HashLen = 16
> End Select
>
> ReDim oPAD(0 To 63 + HashLen) 'leave some space for IntermHash
> ReDim iPad(0 To 63 + UBound(M) + 1) 'same here, but for the Msg-Content M
>
> If UBound(K) + 1 > 64 Then 'Keys, longer than 64Bytes are shortened per
> SHA1
> K = Hash(K, Algo, False)
> End If
>
> LenKey = UBound(K) + 1
>
> For i = 0 To 63 'ensure proper XORing on the first 64Bytes in oPad+iPad
> oPAD(i) = &H5C
> iPad(i) = &H36
> If i < LenKey Then
> oPAD(i) = oPAD(i) Xor K(i)
> iPad(i) = iPad(i) Xor K(i)
> End If
> Next i
>
> RtlMoveMemory iPad(64), M(0), UBound(M) + 1 'append Bytes of M to iPad...
> IntermHash = Hash(iPad, Algo, False) '... and calculate IntermHash
>
> RtlMoveMemory oPAD(64), IntermHash(0), HashLen 'append the result to oPad
>
> HMAC = Hash(oPAD, Algo, AsHexStr) 'and give back the final HMAC
> End Function
>
>
> Olaf

First  |  Prev  |  Next  |  Last
Pages: 1 2 3 4 5
Prev: Drawing blended drop shadows quickly
Next: SetFocus to MDI Control