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
Related
Is there a way to decode email subjects that are encoded? I know the dirty way of doing it is to get the string character between =?utf-8?B? xxx ?= and decoding that. But I have a program where I can get encoded strings like
=?utf-8?Bxxxx?= =?UTF-8?B?xxxx?= ...
Right now I'm doing something like this
If codedString.ToUpper().StartsWith("=?UTF-8?B?") Then
Dim temp As String = codedString.SubString(10)
Dim data = Convert.FromBase64String(temp)
Dim decodedString = ASCIIEncoding.ASCII.GetString(data)
'do something with decodedString
End If
But this doesn't work when the same string has multiple =?utf-8?B? encode like above. Also I can get strings with =?utf-8?Q encoding and =?windows-1252. Is there a way to tackle all of these encoding? I'm using Visual Studios 2017
I've never had trouble using this function to decode a email field value:
It finds matching utf-8 strings for types B or Q, and if type B, runs FromBase64String.
I'm sure you can manipulate for windows-1252.
Private Function DecodeEmailField(byVal strString as String) as String
DecodeEmailField = strString.toString()
Dim strMatch
Dim arrEncodeTypes = New String() {"B","Q"}
Dim strEncodeType as String
For Each strEncodeType in arrEncodeTypes
Dim objRegexB as RegEx = new RegEx("(?:\=\?utf\-8\?" & strEncodeType & "\?)(?:.+?)(?:\?=\s)", _
RegexOptions.Multiline or RegexOptions.IgnoreCase)
if (objRegexB.IsMatch(DecodeEmailField)) then
Dim thisMatch as Match = objRegexB.Match(DecodeEmailField)
For Each strMatch in thisMatch.Groups
Dim strMatchHold as String = strMatch.toString().Substring(("=?utf-8?" & strEncodeType & "?").length)
strMatchHold = strMatchHold.SubString(0,(strMatchHold.Length)-("?= ".Length))
If strEncodeType = "B" Then
Dim data() As Byte = System.Convert.FromBase64String(strMatchHold)
strMatchHold = System.Text.UTF8Encoding.UTF8.GetString(data)
End If
DecodeEmailField = Replace(DecodeEmailField,strMatch.toString(),strMatchHold)
Next
End If
Next
End Function
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
...
I created a simple function designed to remove a string of characters from another string and replace it with what ever string the user wants (or no string as a default)
Private Function RemoveString(scontainer As String, Optional rcontainer As String = "", Optional rstring As String = "") As String
Dim container As String = scontainer
Dim tcontainer As String
If InStr(container, rcontainer) <> 0 Then
Do While (InStr(container, rcontainer) <> 0)
tcontainer = Microsoft.VisualBasic.Left(container, InStr(container, rcontainer) - 1)
tcontainer = tcontainer & rstring & Microsoft.VisualBasic.Right(container, (Len(container) - (InStr(container, rcontainer) + 2)))
container = tcontainer
Loop
RemoveString = container 'return modded string
Else
RemoveString = scontainer 'return string as is
End If
End Function
The problem is:
While this is suppose to be a general use function, I really need it to be concerned with 2 different strings
%20
amp;
the function works perfectly for the %20 situation but it leaves the semi-colon behind for the amp; string. Any ideas why this might be?
Do I get you right ?
You want to replace a certain char sequence in your string with another char sequence or just delete it.
If thats the case you could use String.Replace(oldValue As String, newValue As String) As String
Dim startString as String = "%20 amp;"
Dim resultString as String = startString.Replace("%20 ",String.Empty)
resultString = resultString.Replace(";",String.Empty)
After these lines resultString would be "amp"
I am developing VB.NET windows app. in VS 2010.
I want to get the substring
$CostCenterId|4^10
from the below string .
PaymentMode|NEFT^$IsPaid|False^$Currency|INR-Indian
Rupee^$CostCenterId|4^10$LedgerId|2^3$
The position of current string ($CostCenterId|4^10) in the sequence may be change.
but it will always between the two $ sign.
I have written the below code, but confused abt what to write next ?
Public Sub GetSubstringData()
dim sfullString = "PaymentMode|NEFT^$IsPaid|False^$Currency|INR-Indian
Rupee^$CostCenterId|4^10$LedgerId|2^3$"
Dim CostIndex As Integer
CostIndex = sDiscription.IndexOf("CostCenterId")
sDiscription.Substring(CostIndex,
End Sub
Have a look into the Split function of a string. This allows you to split a string into substrings based on a specified delimiting character.
You can then do this:
Dim sfullString = "PaymentMode|NEFT^$IsPaid|False^$Currency|INR-Indian Rupee^$CostCenterId|4^10$LedgerId|2^3$"
Debug.WriteLine("$" + sfullString.Split("$"c)(3))
Result: $CostCenterId|4^10
You will probably want to do some error checking to make sure the string actually contains the data you expect though.
However looking at the data, what you have is a string containing key-value pairs so you would be better to have a property to hold the CostCenterId and extract the data like this:
Public Property CostCenterId As String
Public Sub Decode(ByVal code As String)
For Each pair As String In code.Split("$"c)
If pair.Length > 0 AndAlso pair.Contains("|") Then
Dim key As String = pair.Split("|"c)(0)
Dim value As String = pair.Split("|"c)(1)
Select Case key
Case "CostCenterId"
Me.CostCenterId = value
End Select
End If
Next
End Sub
Then call it like this:
Decode("PaymentMode|NEFT^$IsPaid|False^$Currency|INR-Indian Rupee^$CostCenterId|4^10$LedgerId|2^3$")
Why not split() the string by $ into an array, and then look for the element which contains CostCenterId
This should work:
Dim token = "$CostCenterId"
Dim costIndexStart As Integer = sfullString.IndexOf(token)
Dim costIndexEnd As Integer = sfullString.IndexOf("$", costIndexStart + token.Length)
Dim cost As String = sfullString.Substring(costIndexStart, costIndexEnd - costIndexStart + 1)
Result: "$CostCenterId|4^10$"
If you want to omit the dollar-signs:
Substring(costIndexStart + 1, costIndexEnd - costIndexStart - 1)
Try something like this:
Dim CostIndex As Integer
CostIndex = sDiscription.IndexOf("CostCenterId")
auxNum = sDiscription.IndexOf("$"c, CostIndex) - CostIndex
sResult = sDiscription.SubString(CostIndex, auxNum)
Your string,
Dim xString = "PaymentMode|NEFT^$IsPaid|False^$Currency|INR-Indian Rupee^$CostCenterId|4^10$LedgerId|2^3$"
Substring process,
xString = xString.Substring(xString.IndexOf("$CostCenter"), xString.IndexOf("$", xString.IndexOf("$CostCenter") + 1) - xString.IndexOf("$CostCenter"))
Try this Code:
Dim sfullString = "PaymentMode|NEFT^$IsPaid|False^$Currency|INR-Indian" _
& "Rupee^$CostCenterId|4^10$LedgerId|2^3$"
Dim sp() As String = {"$"}
Dim ar() As String = sfullString.Split(sp, StringSplitOptions.RemoveEmptyEntries)
Array.Sort(ar)
MsgBox("$" & ar(0))
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