diff --git a/src/StringConverter.bas b/src/StringConverter.bas new file mode 100644 index 00000000..ab5ccb78 --- /dev/null +++ b/src/StringConverter.bas @@ -0,0 +1,38 @@ +Attribute VB_Name = "StringConverter" +'' +' Module used for converting string to UTF8 byte array. +' +' Code taken from page http://www.di-mgt.com.au/howto-convert-vba-unicode-to-utf8.html +' Modified to work in 64-bit Excel using guide at http://stackoverflow.com/questions/21982682/code-does-not-work-on-64-bit-office +' +' Used in WebHelpers.Base64Encode so that the HttpBasicAuthenticator works correctly with Scandinavian letters in username or password. +'' + +''' WinApi function that maps a UTF-16 (wide character) string to a new character string +Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( _ + ByVal CodePage As LongPtr, _ + ByVal dwFlags As LongPtr, _ + ByVal lpWideCharStr As LongPtr, _ + ByVal cchWideChar As LongPtr, _ + ByVal lpMultiByteStr As LongPtr, _ + ByVal cbMultiByte As LongPtr, _ + ByVal lpDefaultChar As LongPtr, _ + ByVal lpUsedDefaultChar As LongPtr) As LongPtr + +' CodePage constant for UTF-8 +Private Const CP_UTF8 = 65001 + +''' Return byte array with VBA "Unicode" string encoded in UTF-8 +Public Function Utf8BytesFromString(strInput As String) As Byte() + Dim nBytes As Variant + Dim abBuffer() As Byte + ' Get length in bytes *including* terminating null + + nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, vbNull, 0&, 0&, 0&) + ' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes + ReDim abBuffer(nBytes - 2) ' NB ReDim with one less byte than you need + nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&) + Utf8BytesFromString = abBuffer + +End Function + diff --git a/src/WebHelpers.bas b/src/WebHelpers.bas index 32cf44e8..430bba9a 100644 --- a/src/WebHelpers.bas +++ b/src/WebHelpers.bas @@ -709,23 +709,23 @@ End Function ' @return {Dictionary|Collection|Object} ' @throws 11000 - Error during parsing '' -Public Function ParseByFormat(Value As String, Format As WebFormat, _ +Public Function ParseByFormat(value As String, Format As WebFormat, _ Optional CustomFormat As String = "", Optional Bytes As Variant) As Object On Error GoTo web_ErrorHandling ' Don't attempt to parse blank values - If Value = "" And CustomFormat = "" Then + If value = "" And CustomFormat = "" Then Exit Function End If Select Case Format Case WebFormat.Json - Set ParseByFormat = ParseJson(Value) + Set ParseByFormat = ParseJson(value) Case WebFormat.FormUrlEncoded - Set ParseByFormat = ParseUrlEncoded(Value) + Set ParseByFormat = ParseUrlEncoded(value) Case WebFormat.Xml - Set ParseByFormat = ParseXml(Value) + Set ParseByFormat = ParseXml(value) Case WebFormat.Custom #If EnableCustomFormatting Then Dim web_Converter As Dictionary @@ -739,15 +739,15 @@ Public Function ParseByFormat(Value As String, Format As WebFormat, _ Set web_Instance = web_Converter("Instance") If web_Converter("ParseType") = "Binary" Then - Set ParseByFormat = VBA.CallByName(web_Instance, web_Callback, VBA.vbMethod, Bytes) + Set ParseByFormat = VBA.CallByName(web_Instance, web_Callback, VBA.VbMethod, Bytes) Else - Set ParseByFormat = VBA.CallByName(web_Instance, web_Callback, VBA.vbMethod, Value) + Set ParseByFormat = VBA.CallByName(web_Instance, web_Callback, VBA.VbMethod, value) End If Else If web_Converter("ParseType") = "Binary" Then Set ParseByFormat = Application.Run(web_Callback, Bytes) Else - Set ParseByFormat = Application.Run(web_Callback, Value) + Set ParseByFormat = Application.Run(web_Callback, value) End If End If #Else @@ -799,7 +799,7 @@ Public Function ConvertToFormat(Obj As Variant, Format As WebFormat, Optional Cu If web_Converter.Exists("Instance") Then Dim web_Instance As Object Set web_Instance = web_Converter("Instance") - ConvertToFormat = VBA.CallByName(web_Instance, web_Callback, VBA.vbMethod, Obj) + ConvertToFormat = VBA.CallByName(web_Instance, web_Callback, VBA.VbMethod, Obj) Else ConvertToFormat = Application.Run(web_Callback, Obj) End If @@ -1046,8 +1046,8 @@ Public Function Base64Encode(Text As String) As String Base64Encode = ExecuteInShell(web_Command).Output #Else Dim web_Bytes() As Byte - - web_Bytes = VBA.StrConv(Text, vbFromUnicode) + + web_Bytes = StringConverter.Utf8BytesFromString(Text) Base64Encode = web_AnsiBytesToBase64(web_Bytes) #End If @@ -1402,11 +1402,11 @@ End Function ' @param {Variant} Value ' @return {Dictionary} '' -Public Function CreateKeyValue(Key As String, Value As Variant) As Dictionary +Public Function CreateKeyValue(Key As String, value As Variant) As Dictionary Dim web_KeyValue As New Dictionary web_KeyValue("Key") = Key - web_KeyValue("Value") = Value + web_KeyValue("Value") = value Set CreateKeyValue = web_KeyValue End Function @@ -1470,12 +1470,12 @@ End Function ' @param {Variant} Value ' @return {Variant} '' -Public Sub AddOrReplaceInKeyValues(KeyValues As Collection, Key As Variant, Value As Variant) +Public Sub AddOrReplaceInKeyValues(KeyValues As Collection, Key As Variant, value As Variant) Dim web_KeyValue As Dictionary Dim web_Index As Long Dim web_NewKeyValue As Dictionary - Set web_NewKeyValue = CreateKeyValue(CStr(Key), Value) + Set web_NewKeyValue = CreateKeyValue(CStr(Key), value) web_Index = 1 For Each web_KeyValue In KeyValues @@ -1888,25 +1888,25 @@ End Function ' ============================================= ' ' Helper for url-encoded to create key=value pair -Private Function web_GetUrlEncodedKeyValue(Key As Variant, Value As Variant, Optional EncodingMode As UrlEncodingMode = UrlEncodingMode.FormUrlEncoding) As String - Select Case VBA.VarType(Value) +Private Function web_GetUrlEncodedKeyValue(Key As Variant, value As Variant, Optional EncodingMode As UrlEncodingMode = UrlEncodingMode.FormUrlEncoding) As String + Select Case VBA.VarType(value) Case VBA.vbBoolean ' Convert boolean to lowercase - If Value Then - Value = "true" + If value Then + value = "true" Else - Value = "false" + value = "false" End If Case VBA.vbDate ' Use region invariant date (ISO-8601) - Value = WebHelpers.ConvertToIso(CDate(Value)) + value = WebHelpers.ConvertToIso(CDate(value)) Case VBA.vbDecimal, VBA.vbSingle, VBA.vbDouble, VBA.vbCurrency ' Use region invariant number encoding ("." for decimal separator) - Value = VBA.Replace(VBA.CStr(Value), ",", ".") + value = VBA.Replace(VBA.CStr(value), ",", ".") End Select ' Url encode key and value (using + for spaces) - web_GetUrlEncodedKeyValue = UrlEncode(Key, EncodingMode:=EncodingMode) & "=" & UrlEncode(Value, EncodingMode:=EncodingMode) + web_GetUrlEncodedKeyValue = UrlEncode(Key, EncodingMode:=EncodingMode) & "=" & UrlEncode(value, EncodingMode:=EncodingMode) End Function ''