@Danyfirex la función no va por mal camino pero al remplazar los "&" la url queda inservible.
No entiendo eso Que me dices? :S
igual aquí dejo un poco optimizada la función agregando Las funciones para UTF8.
Y ahora si simula bien como la pagina.
http://meyerweb.com/eric/tools/dencoder/Private Declare Function WideCharToMultiByte Lib "KERNEL32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "KERNEL32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Const CP_UTF8 As Long = 65001
Private Sub Form_Load()
Debug.Print (URLEncode("https://www.google.com.ar/search?q=canción"))
Debug.Print URLDecode(URLEncode("https://www.google.com.ar/search?q=canción"))
End Sub
Function URLEncode(url As String) As String
Dim sp() As Byte
Dim final As String
sp() = StrConv(Unicode2UTF8(url), vbFromUnicode)
For i = 0 To UBound(sp)
Select Case sp(i)
Case 45, 46, 48 To 57, 65 To 90, 95, 97 To 122, 126
final = final & Chr(sp(i))
Case 32
final = final & "+"
Case Else
final = final & "%" & Hex(sp(i))
End Select
Next
URLEncode = final
End Function
Function URLDecode(url As String) As String
Dim spl() As String
Dim final As String
Dim str As String
str = Replace(url, "+", " ")
spl() = Split(str, "%")
final = spl(0)
For i = 1 To UBound(spl)
final = final & Chr(CLng("&H" & Left(spl(i), 2))) & Mid(spl(i), 3)
Next
URLDecode = UTF82Unicode(final)
End Function
Private Function UTF82Unicode(ByVal sUTF8 As String) As String
Dim UTF8Size As Long
Dim BufferSize As Long
Dim BufferUNI As String
Dim LenUNI As Long
Dim bUTF8() As Byte
If LenB(sUTF8) = 0 Then Exit Function
bUTF8 = StrConv(sUTF8, vbFromUnicode)
UTF8Size = UBound(bUTF8) + 1
BufferSize = UTF8Size * 2
BufferUNI = String$(BufferSize, vbNullChar)
LenUNI = MultiByteToWideChar(CP_UTF8, 0, bUTF8(0), UTF8Size, StrPtr(BufferUNI), BufferSize)
If LenUNI Then
UTF82Unicode = Left$(BufferUNI, LenUNI)
End If
End Function
Private Function Unicode2UTF8(ByVal strUnicode As String) As String
Dim LenUNI As Long
Dim BufferSize As Long
Dim LenUTF8 As Long
Dim bUTF8() As Byte
LenUNI = Len(strUnicode)
If LenUNI = 0 Then Exit Function
BufferSize = LenUNI * 3 + 1
ReDim bUTF8(BufferSize - 1)
LenUTF8 = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), LenUNI, bUTF8(0), BufferSize, vbNullString, 0)
If LenUTF8 Then
ReDim Preserve bUTF8(LenUTF8 - 1)
Unicode2UTF8 = StrConv(bUTF8, vbUnicode)
End If
End Function
saludos
Mostrar Mensajes
talvez lo dices por esto for(i=0;i<5;i++) pues el 5<5 eso es falso por lo tanto no tomara el valor 5.
