I want to translate a VB function to VBA. The function is using "System.Text.UTF8Encoding" and "System.Security.Cryptography.HMACSHA256"
Objects and their ".GetBytes" and ".ComputeHash" methods.
I already added "System" and "mscorlib.dll" referrences to the VBA code, but I'm receiving "Invalid procedure call or argument" error.
Here is my VB function:
Function HashString(ByVal StringToHash As String, ByVal HachKey As String) As String
Dim myEncoder As New System.Text.UTF8Encoding
Dim Key() As Byte = myEncoder.GetBytes(HachKey)
Dim Text() As Byte = myEncoder.GetBytes(StringToHash)
Dim myHMACSHA256 As New System.Security.Cryptography.HMACSHA256(Key)
Dim HashCode As Byte() = myHMACSHA256.ComputeHash(Text)
Dim hash As String = Replace(BitConverter.ToString(HashCode), "-", "")
Return hash.ToLower
End Function
And this is what I've already translated into VBA:
Function HashString(ByRef StringToHash As String, ByRef HachKey As String) As String
Dim myEncoder As Object
Dim myHMACSHA256 As Object
Dim Key As Byte
Dim Text As Byte
Dim HashCode As Byte
Dim hash As String
Set myEncoder = CreateObject("System.Text.UTF8Encoding")
Set myHMACSHA256 = CreateObject("System.Security.Cryptography.HMACSHA256")
Key = myEncoder.GetBytes(HachKey)
Text = myEncoder.GetBytes(StringToHash)
HashCode = myHMACSHA256.ComputeHash(Text)
hash = Replace(BitConverter.ToString(HashCode), "-", "")
HashString = hash.ToLower
End Function
Can anybody help on this? My first guess is that I'm using ".GetBytes" and ".ComputeHash" methods incorrectly
Thanks in advance
A working example to compute the HMACSHA256 with VBA:
Function ComputeHMACSHA256(key As String, text As String) As String
Dim encoder As Object, crypto As Object
Dim hash() As Byte, hmacsha As String, i As Long
' compute HMACSHA256
Set encoder = CreateObject("System.Text.UTF8Encoding")
Set crypto = CreateObject("System.Security.Cryptography.HMACSHA256")
crypto.key = encoder.GetBytes_4(key)
hash = crypto.ComputeHash_2(encoder.GetBytes_4(text))
' convert to an hexa string
hmacsha = String(64, "0")
For i = 0 To 31
Mid$(hmacsha, i + i + (hash(i) > 15) + 2) = Hex(hash(i))
Next
ComputeHMACSHA256 = LCase(hmacsha)
End Function
Sub UsageExample()
Debug.Print ComputeHMACSHA256("abcdef", "12345")
End Sub
When used via COM in order to support overloading .Net functions have implementations based on Name_n. As GetBytes is overloaded you need GetBytes_4() which is the overload that accepts a string and _2 for ComputeHash()
Function HashString(ByRef StringToHash As String, ByRef HachKey As String) As String
Dim myEncoder As Object
Dim myHMACSHA256 As Object
Dim Key() As Byte '// all need to be arrays
Dim Text() As Byte
Dim HashCode() As Byte
Dim hash As String
Set myEncoder = CreateObject("System.Text.UTF8Encoding")
Set myHMACSHA256 = CreateObject("System.Security.Cryptography.HMACSHA256")
Key = myEncoder.GetBytes_4(HachKey)
Text = myEncoder.GetBytes_4(StringToHash)
HashCode = myHMACSHA256.ComputeHash_2(Text)
Dim i As Long
For i = 0 To UBound(HashCode)
Debug.Print Format$(Hex(HashCode(i)), "00")
Next
End Function
?HashString("qwe", "rty")
80
D5
22
5D
83
06
...
Related
It's a simple code
var contentHash = CryptoJS.SHA512(JSON.stringify(requestBody)).toString(CryptoJS.enc.Hex);
Also it's actually simpler. I think requestBody is just an empty string.
https://bittrex.github.io/api/v3#topic-Authentication
What I tried is to do
Dim hasher = New System.Security.Cryptography.HMACSHA512(System.Text.Encoding.UTF8.GetBytes(""))
Dim contentHash = ExchangesClass.getString(hasher.ComputeHash(System.Text.Encoding.UTF8.GetBytes("")))
Where ExchangeClass.getString is
Public Shared Function getString(sigs As Byte()) As String
Dim list = New Generic.List(Of String)
For Each b In sigs
Dim chunk = b.ToString("x2")
list.Add(chunk)
Next
Dim result = String.Concat(list)
Dim result2 = BitConverter.ToString(sigs).Replace("-", "").ToLower()
Debug.Assert(result = result2)
Return result
End Function
But that's sort of weird. Why would anyone want a hash of an empty string. Unless I am missing something. I do not see where requestBody is. Perhaps because I use only read only API of bittrex
This code works
So
var contentHash = CryptoJS.SHA512(JSON.stringify(requestBody)).toString(CryptoJS.enc.Hex);
becomes
Protected Overridable Function computeSigNoHmac(content As String) As String
Dim hasher2 = New System.Security.Cryptography.SHA512Managed() 'create hashers based on those bytes
Dim hashbytes = hasher2.ComputeHash(System.Text.Encoding.UTF8.GetBytes(content)) 'compute the hash and get bytes
Dim sighash2 = BitConverter.ToString(hashbytes).Replace("-", "").ToLower() 'turn bytes into hex string (0-9a-f)
Return sighash2
End Function
Also, for completion,
var signature = CryptoJS.HmacSHA512(preSign, apiSecret).toString(CryptoJS.enc.Hex);
Becomes
Protected Overridable Function computeSig(content As String, secret As String) As String
Dim secretinBytes = System.Text.Encoding.UTF8.GetBytes(secret) 'Turn secret hex into bytes (0-9a-f)
Dim hasher2 = New System.Security.Cryptography.HMACSHA512(secretinBytes) 'create hashers based on those bytes
'Dim hasher3 = New System.Security.Cryptography.SHA512(secretinBytes) 'create hashers based on those bytes
Dim hashbytes = hasher2.ComputeHash(System.Text.Encoding.UTF8.GetBytes(content)) 'compute the hash and get bytes
Dim sighash2 = BitConverter.ToString(hashbytes).Replace("-", "").ToLower() 'turn bytes into hex string (0-9a-f)
Return sighash2
End Function
I'm aware of the other thread on this issue (AES decryption error " The input data is not a complete block." Error vb.net), but I'm either not implementing the solutions offered there correctly, or something about my particular variant of this issue isn't covered by those solutions. In any event I'm getting the incomplete block error from the following code
Private GD As System.Security.Cryptography.Aes = System.Security.Cryptography.Aes.Create
Private PDB As New System.Security.Cryptography.Rfc2898DeriveBytes(EK, New Byte() {&H49, &H76, &H61, &H6E, &H20, &H4D, &H65, &H64, &H76, &H65, &H64, &H65, &H76})
Public Function Decrypt(ByVal val As String) As String
Dim ret As String = Nothing
Dim TTB As New System.Text.UTF8Encoding
Try
Dim input() As Byte = TTB.GetBytes(val)
Using ms As New System.IO.MemoryStream(input)
Using cs As New System.Security.Cryptography.CryptoStream(ms, GD.CreateDecryptor(PDB.GetBytes(32), PDB.GetBytes(16)), Security.Cryptography.CryptoStreamMode.Read)
Using sr As New System.IO.StreamReader(cs)
ret = sr.ReadToEnd()
End Using
End Using
End Using
input = nothing
Catch ex As Exception
EL.AddErr("Encountered an error while decrypting the provided text for " & FName & ". Error Details: " & ex.Message, path)
End Try
Return ret
End Function
EK is my key, which I'll not be including. It's just a String though, nothing special.
I've tried several other methods to decrypt based on guidance on the MSDN site, DreamInCode, etc. None worked, but they all had different issues (typically returning a blank string). Seeing as this version of code closely mirrors my encryption code, I'd like to stick with it (or at least as close as I can while still having functional code).
Despite all comments, I still lack understanding of your intentions. Therefore, the sample code below may not provide what you exactly want, but at least should give an idea how to employ cryptographic functions. Particularly, the most notable difference from your approach is that the encryption key and initialization vector are computed once and for all messages, rather than reevaluated on each occasion, because the latter is prone to synchronization errors — such as when you reuse single crypto object to communicate with multiple parties, or when some messages get lost in transmission.
Public Shared Sub Test()
' Note: You should not actually hard-code any sensitive information in your source files, ever!
Dim sKeyPreimage As String = "MySuperPassword"
Dim oMyCrypto As New MyCrypto(sKeyPreimage)
Dim sPlaintext As String = "My super secret data"
Dim sEncrypted As String = oMyCrypto.EncryptText(sPlaintext)
Dim sDecrypted As String = oMyCrypto.DecryptText(sEncrypted)
Console.Out.WriteLine("Plaintext: {0}", sPlaintext) ' "My super secret data"
Console.Out.WriteLine("Encrypted: {0}", sEncrypted) ' "72062997872DC4B4D1BCBF48D5D30DF0D498B20630CAFA28D584CCC3030FC5F1"
Console.Out.WriteLine("Decrypted: {0}", sDecrypted) ' "My super secret data"
End Sub
Public Class MyCrypto
Private Shared TextEncoding As Text.Encoding = Text.Encoding.UTF8
Private CipherEngine As System.Security.Cryptography.SymmetricAlgorithm
' Note: Unlike in the question, same key and IV are reused for all messages.
Private CipherKey() As Byte
Private CipherIV() As Byte
Public Sub New(ByVal sKeyPreimage As String)
Dim abKeyPreimage() As Byte = TextEncoding.GetBytes(sKeyPreimage)
Dim abKeySalt() As Byte = TextEncoding.GetBytes("Ivan Medvedev")
Const KeyDerivationRounds As Integer = 1 << 12
Dim oKeyDerivationEngine As New System.Security.Cryptography.Rfc2898DeriveBytes(abKeyPreimage, abKeySalt, KeyDerivationRounds)
Me.CipherEngine = System.Security.Cryptography.Aes.Create()
Me.CipherEngine.Padding = Security.Cryptography.PaddingMode.PKCS7
Me.CipherKey = oKeyDerivationEngine.GetBytes(Me.CipherEngine.KeySize >> 3)
Me.CipherIV = oKeyDerivationEngine.GetBytes(Me.CipherEngine.BlockSize >> 3)
End Sub
Public Function Encrypt(ByVal abPlaintext() As Byte) As Byte()
Dim abCiphertext() As Byte
Using hStreamSource As New System.IO.MemoryStream(abPlaintext),
hStreamCipher As New System.Security.Cryptography.CryptoStream(
hStreamSource,
Me.CipherEngine.CreateEncryptor(Me.CipherKey, Me.CipherIV),
Security.Cryptography.CryptoStreamMode.Read),
hStreamTarget As New System.IO.MemoryStream
hStreamCipher.CopyTo(hStreamTarget)
abCiphertext = hStreamTarget.ToArray()
End Using
Return abCiphertext
End Function
Public Function Decrypt(ByVal abCiphertext() As Byte) As Byte()
Dim abPlaintext() As Byte
Using hStreamSource As New System.IO.MemoryStream(abCiphertext),
hStreamCipher As New System.Security.Cryptography.CryptoStream(
hStreamSource,
Me.CipherEngine.CreateDecryptor(Me.CipherKey, Me.CipherIV),
Security.Cryptography.CryptoStreamMode.Read),
hStreamTarget As New System.IO.MemoryStream
hStreamCipher.CopyTo(hStreamTarget)
abPlaintext = hStreamTarget.ToArray()
End Using
Return abPlaintext
End Function
Public Function EncryptText(ByVal sPlaintext As String) As String
Dim abPlaintext() As Byte = TextEncoding.GetBytes(sPlaintext)
Dim abCiphertext() As Byte = Me.Encrypt(abPlaintext)
Dim sCiphertext As String = Hex.Format(abCiphertext)
Return sCiphertext
End Function
Public Function DecryptText(ByVal sCiphertext As String) As String
Dim abCiphertext() As Byte = Hex.Parse(sCiphertext)
Dim abPlaintext() As Byte = Me.Decrypt(abCiphertext)
Dim sPlaintext As String = TextEncoding.GetChars(abPlaintext)
Return sPlaintext
End Function
End Class
Public Class Hex
Public Shared Function Format(ByVal abValue() As Byte) As String
Dim asChars(0 To abValue.Length * 2 - 1) As Char
Dim ndxChar As Integer = 0
For ndxByte As Integer = 0 To abValue.Length - 1
Dim bNibbleHi As Byte = abValue(ndxByte) >> 4, bNibbleLo As Byte = CByte(abValue(ndxByte) And &HFUS)
asChars(ndxChar) = Convert.ToChar(If(bNibbleHi <= 9, &H30US + bNibbleHi, &H37US + bNibbleHi)) : ndxChar += 1
asChars(ndxChar) = Convert.ToChar(If(bNibbleLo <= 9, &H30US + bNibbleLo, &H37US + bNibbleLo)) : ndxChar += 1
Next
Return New String(asChars)
End Function
Public Shared Function Parse(ByVal sValue As String) As Byte()
If String.IsNullOrEmpty(sValue) Then Return New Byte() {}
If (sValue.Length Mod 2) > 0 Then Return Nothing
Dim ndxText As Integer = 0
Dim ndxByteMax As Integer = (sValue.Length \ 2) - 1
Dim abValue(0 To ndxByteMax) As Byte
Try
For ndxByte As Integer = 0 To ndxByteMax
abValue(ndxByte) = Convert.ToByte(sValue.Substring(ndxText, 2), 16)
ndxText += 2
Next
Catch ex As Exception
Return Nothing
End Try
Return abValue
End Function
End Class
Again, please, note that this is just an example. I am not endorsing any kind of protection techniques shown here, especially because your task remains unknown. The code above simply illustrates the syntax and semantics — not how to do it right.
I need to add this encryptdecrypt code ÄÖÅ characters, but i don't know how?
Here's my code:
Public Function EncryptDecryptString(ByVal inputString As String, Optional ByVal decrypt As Boolean = False) As String
Dim sourceChars As String = " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
Dim resultChars As String = "36N8lkXruq94jMZInPpshR xHc2mTQb7eYai5vGWDzFdoC0wKSBt1EOgVALJfUy"
Dim result As String
If decrypt Then
result = New String(inputString.Select(Function(c) sourceChars(resultChars.IndexOf(c))).ToArray())
Else
result = New String(inputString.Select(Function(c) resultChars(sourceChars.IndexOf(c))).ToArray())
End If
Return result
End Function
You current code will work (as well as it does for English characters) if you simply add the Swedish characters to both sourceChars and resultChars like this.
Dim sourceChars As String = " ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÅabcdefghijklmnopqrstuvwxyz0123456789äöå"
Dim resultChars As String = "äöå36N8lkXruq94jMZInPpshR xHc2mTQb7eYai5ÄÖÅvGWDzFdoC0wKSBt1EOgVALJfUy"
However, your code will fail if the input string contains any character that you are not expecting (for example a tab character or newline). Here is a version of the function that doesn't throw an exception on an unexpected character, but simply uses it without encrypting that character (for serious encryption, it would be better to get an exception).
Public Function EncryptDecryptString(ByVal inputString As String, Optional ByVal decrypt As Boolean = False) As String
Dim sourceChars As String = " ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÅabcdefghijklmnopqrstuvwxyz0123456789äöå"
Dim resultChars As String = "äöå36N8lkXruq94jMZInPpshR xHc2mTQb7eYai5ÄÖÅvGWDzFdoC0wKSBt1EOgVALJfUy"
Dim result() As Char = inputString
Dim inChars As String = If(decrypt, resultChars, sourceChars)
Dim outChars As String = If(decrypt, sourceChars, resultChars)
For i As Integer = 0 To inputString.Length - 1
Dim pos As Integer = inChars.IndexOf(inputString(i))
If pos >= 0 Then result(i) = outChars(pos)
Next
Return result
End Function
I have a chat system and i want to put a "random string generator".
In my chat i have to write "%random%" and it is replaces with a random string.
I have a problem though, if i type "%random%%random%%random%" for example, it will generate the same string 3 times.
• Here is my function:
Public Function getRandomString(ByVal len As Integer) As String
Randomize()
Dim stringMap as string = "abcdefghijklmnopqrstuwvxyz0123456789"
Dim rndString As String = ""
Dim rnd As New Random()
For i As Integer = 0 To len - 1
Randomize()
rndString &= stringMap.Substring(rnd.Next(0, stringMap.Length), 1)
Next
Return rndString
End Function
• And here is my function call:
Dim msg As String = "Random string: %random%%random%%random%"
msg = msg.Replace("%random%", getRandomString(8))
MsgBox(msg)
The output for example: Random string: 5z15if725z15if725z15if72
I guess this is because it keeps the 1st return value in memory and pastes it, how can i fix that ?
Do i have to make a string.replace function myself ? Thanks
Oh no! You shouldn't call Randomize() here at all! Random is used in combination with the Rnd() function of VB. Creating a new Random object is enough here.
The reason you are getting the same results every time is because you are creating a new Random every time. You should reuse the same object to get different results.
'Create the object once
Private Shared rnd As New Random()
Public Function getRandomString(ByVal len As Integer) As String
Dim stringMap as string = "abcdefghijklmnopqrstuwvxyz0123456789"
Dim rndString As String = ""
For i As Integer = 0 To len - 1
rndString &= stringMap.Substring(rnd.Next(0, stringMap.Length), 1)
Next
Return rndString
End Function
EDIT: I realize that in addition to the above changes, you need to call the getRandomString function for every "%random%". String.Replace only calls the function once and pastes the result everywhere. With Regex, you could do something like this:
msg = new Regex("%random%").Replace(input, Function (match) getRandomString(8))
An easy way to do it is to find the first occurrence of "%random%", replace that, then repeat as necessary.
Written as a console application:
Option Infer On
Module Module1
Dim rand As New Random
Public Function getRandomString(ByVal len As Integer) As String
Dim stringMap As String = "abcdefghijklmnopqrstuwvxyz0123456789"
Dim rndString As String = ""
For i As Integer = 0 To len - 1
rndString &= stringMap.Substring(rand.Next(0, stringMap.Length), 1)
Next
Return rndString
End Function
Function ReplaceRandoms(s As String) As String
Dim stringToReplace = "%random%"
Dim r = s.IndexOf(stringToReplace)
While r >= 0
s = s.Remove(r, stringToReplace.Length).Insert(r, getRandomString(stringToReplace.Length))
r = s.IndexOf(stringToReplace)
End While
Return s
End Function
Sub Main()
Dim msg As String = "Random string: %random%%random%%random%"
msg = ReplaceRandoms(msg)
Console.WriteLine(msg)
Console.ReadLine()
End Sub
End Module
I can't seem to work out how to get a value from my string using VB.net
If I have a string in my textbox that says:
WWW-Authenticate: Digest realm="MyServer",qop="auth",algorithm="MD5",maxbuf=1000,nonce="3b010c090c0a0000c0a80157c7007f03c5",opaque="4e6573732041636365737320436f6e74"
How can I get each of the values after the = in the string.
I have tried using
Dim s = "WWW-Authenticate: Digest realm='MyServer',qop='auth',algorithm='MD5',maxbuf=1000,nonce='3b010c090c0a0000c0a80157c7007f03c5',opaque='4e6573732041636365737320436f6e74'"
Dim pattern = "="
Dim matches = Regex.Matches(s, pattern)
Dim values = matches.OfType(Of Match).Select(Function(m) m.Value)
For Each v In values
MsgBox(v)
Next
But it only returns the = in the messagebox.
I want to be able to get just the part after the = sign.
Anyone able to help?
I have tried using the following but it still includes the realm= qop= etc.. in the string. (but includes it at the end of the next item.
Dim s = "WWW-Authenticate: Digest realm='Ness Access Control',qop='auth',algorithm='MD5',maxbuf=1000,nonce='3b010c090c0a0000c0a80157c7007f03c5',opaque='4e6573732041636365737320436f6e74'"
Dim result_array As Array = Split(s, "=", 6)
For Each v In result_array
MsgBox(v)
Next
Regular Expressions!
Imports System.Text.RegularExpressions
Module Module1
Sub Main()
Dim s As String = "WWW-Authenticate: Digest realm='MyServer',qop='auth',algorithm='MD5',maxbuf=1000,nonce='3b010c090c0a0000c0a80157c7007f03c5',opaque='4e6573732041636365737320436f6e74'"
'Regular Expression, matches word before equals, and word after equals
Dim r As New Regex("(\w+)\='([^']+)'")
'All the matches!
Dim matches As MatchCollection = r.Matches(s)
For Each m As Match In matches
'm.Groups(1) = realm, qop, algorithm...
'm.Groups(2) = MyServer, auth, MD5...
Console.WriteLine(m.Groups(2))
Next
Console.ReadLine()
End Sub
End Module
And if you want everything in a nice key-value dictionary:
Dim dict As New Dictionary(Of String, String)
For Each m As Match In matches
'm.Groups(1) = realm, qop, algorithm...
'm.Groups(2) = MyServer, auth, MD5...
dict(m.Groups(1).ToString()) = dict(m.Groups(2).ToString())
Next
A case for a specific string extension.
How to transform a specific formatted string in a Dictionary with keys and values
Public Module StringModuleExtensions
<Extension()>
Public Function ToStringDictionary(ByVal str as String, _
ByVal OuterSeparator as Char, _
ByVal NameValueSeparator as Char) _
As Dictionary(of String, String)
Dim dicText = New Dictionary(Of String, String)()
if Not String.IsNullOrEmpty(str) then
Dim arrStrings() = str.TrimEnd(OuterSeparator).Split(OuterSeparator)
For Each s in arrStrings
Dim posSep = s.IndexOf(NameValueSeparator)
Dim name = s.Substring(0, posSep)
Dim value = s.Substring(posSep + 1)
dicText.Add(name, value)
Next
End If
return dicText
End Function
End Module
Call with
Dim test = "WWW-Authenticate: Digest realm=""MyServer"",qop=""auth"",algorithm=""MD5"", maxbuf=1000,nonce=""3b010c090c0a0000c0a80157c7007f03c5"",opaque=""4e6573732041636365737320436f6e74"""
Dim dict = test.ToStringDictionary(","c, "="c)
For Each s in dict.Keys
Console.WriteLine(dict(s))
Next
(probably you need to remove the WWW-Authenticate line before.
You are looking for the split() function.
Dim logArray() As String
logArray = Split(s, "=")
For count = 0 To logArr.Length - 1
MsgBox(logArray(count))
Next