Visual Basic 6 (VB6) is like a mythical creature: no matter how hard you try to get rid of it, it always comes back haunting you sooner or later: most of the times it assumes the form of some old and outdated home-made software you really would like to dismiss, yet you still have it somewhere. Today we had another resurrection in our office involving a very old client-based software that we still use here and there.
The issue we had to face was related to the following URLEncode function hidden within the source code:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 |
Function URLEncode(EncodeStr As String) As String Dim i As Integer Dim erg As String erg = EncodeStr ' *** First replace '%' chr erg = Replace(erg, "%", Chr(1)) ' *** then '+' chr erg = Replace(erg, "+", Chr(2)) For i = 0 To 255 Select Case i ' *** Allowed 'regular' characters Case 37, 43, 48 To 57, 65 To 90, 97 To 122 Case 1 ' *** Replace original % erg = Replace(erg, Chr(i), "%25") Case 2 ' *** Replace original + erg = Replace(erg, Chr(i), "%2B") Case 32 erg = Replace(erg, Chr(i), "+") Case 3 To 15 erg = Replace(erg, Chr(i), "%0" & Hex(i)) Case Else erg = Replace(erg, Chr(i), "%" & Hex(i)) End Select Next URLEncode = erg End Function |
Which worked fine if you can live with Windows-1252 strings, yet is not ideal when you work with UTF-8 only. For example, if you have the À character, the following function will convert it to %C0, which is hardly what you want: if you plan to URLDecode that string in a UTF-8 environment, you'll end up having an invalid character rather than the original one.
In order to fix that we quickly arranged the following static class which fixed our problem. This is basically an UTF16-into-UTF8 URLEncode that happens to be compatible with most URLDecode built-in functions (PHP, ASP.NET, JAVA and so on).
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 |
Private Declare Sub CopyToMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) Public Function URLEncode_UTF8( _ ByVal Text As String _ ) As String Dim Index1 As Long Dim Index2 As Long Dim Result As String Dim Chars() As Byte Dim Char As String Dim Byte1 As Byte Dim Byte2 As Byte Dim UTF16 As Long For Index1 = 1 To Len(Text) CopyToMemory Byte1, ByVal StrPtr(Text) + ((Index1 - 1) * 2), 1 CopyToMemory Byte2, ByVal StrPtr(Text) + ((Index1 - 1) * 2) + 1, 1 UTF16 = Byte2 UTF16 = UTF16 * 256 + Byte1 Chars = GetUTF8FromUTF16(UTF16) For Index2 = LBound(Chars) To UBound(Chars) Char = Chr(Chars(Index2)) If Char Like "[0-9A-Za-z]" Then Result = Result & Char Else Result = Result & "%" & Hex(Asc(Char)) End If Next Next GetEncodedUTF8String = Result End Function Private Function GetUTF8FromUTF16( _ ByVal UTF16 As Long _ ) As Byte() Dim Result() As Byte If UTF16 < &H80 Then ReDim Result(0 To 0) Result(0) = UTF16 ElseIf UTF16 < &H800 Then ReDim Result(0 To 1) Result(1) = &H80 + (UTF16 And &H3F) UTF16 = UTF16 \ &H40 Result(0) = &HC0 + (UTF16 And &H1F) Else ReDim Result(0 To 2) Result(2) = &H80 + (UTF16 And &H3F) UTF16 = UTF16 \ &H40 Result(1) = &H80 + (UTF16 And &H3F) UTF16 = UTF16 \ &H40 Result(0) = &HE0 + (UTF16 And &HF) End If GetUTF8FromUTF16 = Result End Function |
If you stumbled upon this post, such class should fix your problem too.
GetEncodedUTF8String = Result
should be
URLEncode_UTF8 = Result
thanks for the code, solved my problem!