Results 1 to 6 of 6

Thread: VB6 - URLencode & URLdecode

  1. #1

    Thread Starter
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    VB6 - URLencode & URLdecode

    URLencode and URLdecode are functions that take a string and convert it to/from string that can be used as a GET item or it's value in a URL.

    Rules:
    • A-Z, a-z and 0-9 are retained as-is
    • Space is converted to + (but %20 is also valid)
    • Any other character is converted to two character hex number prepended with a %
    • Optional: Unicode characters support (all versions below are ANSI only)



    Make shorter than these:
    Code:
    Public Function URLdecshort(ByRef Text As String) As String
        Dim strArray() As String, lngA As Long
        strArray = Split(Replace(Text, "+", " "), "%")
        For lngA = 1 To UBound(strArray)
            strArray(lngA) = Chr$("&H" & Left$(strArray(lngA), 2)) & Mid$(strArray(lngA), 3)
        Next lngA
        URLdecshort = Join(strArray, vbNullString)
    End Function
    
    Public Function URLencshort(ByRef Text As String) As String
        Dim lngA As Long, strChar As String
        For lngA = 1 To Len(Text)
            strChar = Mid$(Text, lngA, 1)
            If strChar Like "[A-Za-z0-9]" Then
            ElseIf strChar = " " Then
                strChar = "+"
            Else
                strChar = "%" & Right$("0" & Hex$(Asc(strChar)), 2)
            End If
            URLencshort = URLencshort & strChar
        Next lngA
    End Function

    Make faster than these:
    Code:
    Public Function URLdecode(ByRef Text As String) As String
        Const Hex = "0123456789ABCDEF"
        Dim lngA As Long, lngB As Long, lngChar As Long, lngChar2 As Long
        URLdecode = Text
        lngB = 1
        For lngA = 1 To LenB(Text) - 1 Step 2
            lngChar = Asc(MidB$(URLdecode, lngA, 2))
            Select Case lngChar
                Case 37
                    lngChar = InStr(Hex, MidB$(Text, lngA + 2, 2)) - 1
                    If lngChar >= 0 Then
                        lngChar2 = InStr(Hex, MidB$(Text, lngA + 4, 2)) - 1
                        If lngChar2 >= 0 Then
                            MidB$(URLdecode, lngB, 2) = Chr$((lngChar * &H10&) Or lngChar2)
                            lngA = lngA + 4
                        Else
                            If lngB < lngA Then MidB$(URLdecode, lngB, 2) = MidB$(Text, lngA, 2)
                        End If
                    Else
                        If lngB < lngA Then MidB$(URLdecode, lngB, 2) = MidB$(Text, lngA, 2)
                    End If
                Case 43
                    MidB$(URLdecode, lngB, 2) = " "
                Case Else
                    If lngB < lngA Then MidB$(URLdecode, lngB, 2) = MidB$(Text, lngA, 2)
            End Select
            lngB = lngB + 2
        Next lngA
        URLdecode = LeftB$(URLdecode, lngB - 1)
    End Function
    
    Public Function URLencode(ByRef Text As String) As String
        Const Hex = "0123456789ABCDEF"
        Dim lngA As Long, lngChar As Long
        URLencode = Text
        For lngA = LenB(URLencode) - 1 To 1 Step -2
            lngChar = Asc(MidB$(URLencode, lngA, 2))
            Select Case lngChar
                Case 48 To 57, 65 To 90, 97 To 122
                Case 32
                    MidB$(URLencode, lngA, 2) = "+"
                Case Else
                    URLencode = LeftB$(URLencode, lngA - 1) & "%" & Mid$(Hex, (lngChar And &HF0) \ &H10 + 1, 1) & Mid$(Hex, (lngChar And &HF&) + 1, 1) & MidB$(URLencode, lngA + 2)
            End Select
        Next lngA
    End Function

    Code for timing:
    Code:
    Option Explicit
    
    Private Declare Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
    
    Dim m_Time As Double
    Dim m_TimeFreq As Double
    Dim m_TimeStart As Currency
    
    Public Property Get Timing() As Double
        Dim curTime As Currency
        QueryPerformanceCounter curTime
        Timing = (curTime - m_TimeStart) * m_TimeFreq + m_Time
    End Property
    
    Public Property Let Timing(ByVal NewValue As Double)
        Dim curFreq As Currency, curOverhead As Currency
        m_Time = NewValue
        QueryPerformanceFrequency curFreq
        m_TimeFreq = 1 / curFreq
        QueryPerformanceCounter curOverhead
        QueryPerformanceCounter m_TimeStart
        m_TimeStart = m_TimeStart + (m_TimeStart - curOverhead)
    End Property
    Timing usage:
    Code:
    ' before benchmark
    Timing = 0
    
    ' after benchmark
    Debug.Print "Result: " & Format$(Timing, "0.000000")

    As far as I know, you can make a shorter code than the first two examples above and you can also make (much) faster than the next two examples above

  2. #2
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - URLencode & URLdecode

    You can also do this via API calls, with some interesting differences. See the comments in URLUtility.cls for one oddity.

    I haven't timed this, but without the hack for "space to +" encoding it should be reasonably quick.
    Attached Files Attached Files

  3. #3
    Hyperactive Member
    Join Date
    Aug 2008
    Posts
    353

    Re: VB6 - URLencode & URLdecode

    Great!
    Thanks for helping me out.

  4. #4
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: VB6 - URLencode & URLdecode

    Caution:

    It doesn't appear that any of the code above handles URLs that are encoded as UTF-8 before URL Encoding. UTF-8 is now common and standard, so be cautious.

    The API calls I used don't help either, the flag needed to support UTF-8 doesn't exist until Windows 8.

  5. #5
    Lively Member vbLewis's Avatar
    Join Date
    Feb 2009
    Location
    USA
    Posts
    126

    Re: VB6 - URLencode & URLdecode

    I wrote a URLencode function that supports UTF8 heavily modified and tweaked from an example i found on the web. I managed to more than double the speed of the original code. As you can see it is only about 10 nanoseconds slower than the non-UTF8 functions. Dillantes API code is the fastest at the cost of no UTF8 support. I also tweaked Merri's example but only made minimal gains since URLs are generally only 50-100 characters and string caching gains arent noticeable on small data. I will edit once i get a decode function written with UTF8 support.

    UTF8 encode

    Code:
    Public Function URLEncode_UTF8(ByVal sText As String) As String
    
        Dim x1 As Long
        Dim x2 As Long
        Dim Chars() As Byte
        Dim Byte1 As Byte
        Dim Byte2 As Byte
        Dim UTF16 As Long
        
        For x1 = 1 To Len(sText)
            CopyMemory Byte1, ByVal StrPtr(sText) + ((x1 - 1) * 2), 1
            CopyMemory Byte2, ByVal StrPtr(sText) + ((x1 - 1) * 2) + 1, 1
    
            UTF16 = Byte2 * 256 + Byte1
    
            If UTF16 < &H80 Then
                ReDim Chars(0) As Byte
                Chars(0) = UTF16
            ElseIf UTF16 < &H800 Then
                ReDim Chars(1) As Byte
                Chars(1) = &H80 + (UTF16 And &H3F)
                UTF16 = UTF16 \ &H40
                Chars(0) = &HC0 + (UTF16 And &H1F)
            Else
                ReDim Chars(2) As Byte
                Chars(2) = &H80 + (UTF16 And &H3F)
                UTF16 = UTF16 \ &H40
                Chars(1) = &H80 + (UTF16 And &H3F)
                UTF16 = UTF16 \ &H40
                Chars(0) = &HE0 + (UTF16 And &HF)
            End If
    
            For x2 = 0 To UBound(Chars)
                Select Case Chars(x2)
                    Case 48 To 57, 65 To 90, 97 To 122
                        URLEncode_UTF8 = URLEncode_UTF8 & Chr$(Chars(x2))
                    Case Else
                        URLEncode_UTF8 = URLEncode_UTF8 & ("%" & Hex$(Chars(x2)))
                End Select
            Next
        Next
    
    End Function


    Tweaked Merri code

    Code:
    Public Function URLEncode(ByVal sText As String) As String
    
        Const Hex As String = "0123456789ABCDEF"
    
        Dim X As Long, lngChar As Long, lLen As Long, lIndex As Long
    
        lLen = Len(sText)
        URLEncode = Space$(lLen * 3)
    
        lIndex = 1
        For X = 1 To lLen
            lngChar = Asc(Mid$(sText, X, 1))
            Select Case lngChar
                Case 48 To 57, 65 To 90, 97 To 122
                    Mid(URLEncode, lIndex, 1) = Chr$(lngChar)
                    lIndex = lIndex + 1
                Case 32
                    Mid$(URLEncode, lIndex, 1) = "+"
                    lIndex = lIndex + 1
                Case Else
                    Mid(URLEncode, lIndex, 3) = "%" & Mid$(Hex, (lngChar And &HF0) \ &H10 + 1, 1) & Mid$(Hex, (lngChar And &HF&) + 1, 1)
                    lIndex = lIndex + 3
            End Select
        Next X
    
        URLEncode = Left$(URLEncode, lIndex - 1)
    
    End Function

    Name:  sssss.jpg
Views: 4465
Size:  28.0 KB

  6. #6
    Addicted Member
    Join Date
    Mar 2009
    Posts
    244

    Re: VB6 - URLencode & URLdecode

    Was looking for this too, but the Merri's decode is CASE SENSITIVE, whereas url URL percent-encoding is NOT case sensitive according to RFC 3986:

    So make sure you add vbTextCompare to the InStr of Merri's code, as default it's vbBinaryCompare
    Code:
    lngChar = InStr(1, Hex, MidB$(Text, lngA + 2, 2), vbTextCompare) - 1
    
    lngChar2 = InStr(1, Hex, MidB$(Text, lngA + 4, 2), vbTextCompare) - 1
    I haven't timed it, but an alternative way to decoding the hex part might be the following:
    (this is slower if Instr is faster then Asc in combination with the extra Select Case's)
    Code:
            '--------------------------------------------------------------
            'Get next character to check if it's a hexadecimal character
            lngChar = Asc(MidB$(Text, lngA + 2, 2))
            Select Case lngChar
              '--------------------------------------------------------------
              '0-9/A-F/a-f
              Case 48 To 57, _
                   65 To 70, _
                   97 To 102
                '--------------------------------------------------------------
                'Convert character back to number
                Select Case lngChar
                  Case Is < 65: lngChar = lngChar - 48
                  Case Is < 97: lngChar = lngChar - 55 'A=10 (-65 would make it 0)
                  Case Else:    lngChar = lngChar - 87 'a=10 (-97 would make it 0)
                End Select
                '--------------------------------------------------------------
                'Get next character to check if it's a hexadecimal character
                lngChar2 = Asc(MidB$(Text, lngA + 4, 2))
                Select Case lngChar2
                  '--------------------------------------------------------------
                  '0-9/A-F/a-f
                  Case 48 To 57, _
                       65 To 70, _
                       97 To 102
                    '--------------------------------------------------------------
                    'Convert character back to number
                    Select Case lngChar2
                      Case Is < 65: lngChar2 = lngChar2 - 48
                      Case Is < 97: lngChar2 = lngChar2 - 55 'A=10 (-65 would make it 0)
                      Case Else:    lngChar2 = lngChar2 - 87 'a=10 (-97 would make it 0)
                    End Select
                    '--------------------------------------------------------------
                    'add converted character
                    MidB$(URLdecode, lngB, 2) = Chr$((lngChar * &H10&) Or lngChar2)
                    lngA = lngA + 4
                  '--------------------------------------------------------------
                  '%
                  Case Else
                    '--------------------------------------------------------------
                    'Add original character
                    If lngB < lngA Then MidB$(URLdecode, lngB, 2) = MidB$(Text, lngA, 2)
                End Select
              '--------------------------------------------------------------
              '%
              Case Else
                If lngB < lngA Then MidB$(URLdecode, lngB, 2) = MidB$(Text, lngA, 2)
            End Select

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width