Autor
|
Tema: [Reto] UrlEncode y UrlDecode (Leído 9,347 veces)
|
cobein
|
Bueno ahi esta con APIs, lo unico que vi que no es igual a lo que pedis es que las barras en los parametros no las codifica... no se, en teoria codifica lo necesario segun M$. '--------------------------------------------------------------------------------------- ' Module : mUrlEncode ' DateTime : 21/12/2012 - Fin del Mundo! ' Author : Cobein ' Mail : cobein27@hotmail.com ' Purpose : Encode and Decode url parameters ' Requirements: None ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '--------------------------------------------------------------------------------------- Option Explicit Private Const ICU_ESCAPE As Long = &H80000000 Private Const ICU_DECODE As Long = &H10000000 Private Const CP_UTF8 As Long = 65001 Private Const ICU_BROWSER_MODE As Long = &H2000000 Private Type URL_COMPONENTS StructSize As Long Scheme As String SchemeLength As Long nScheme As Long HostName As String HostNameLength As Long nPort As Long UserName As String UserNameLength As Long Password As String PasswordLength As Long URLPath As String UrlPathLength As Long ExtraInfo As String ExtraInfoLength As Long End Type Private Declare Function InternetCrackUrl Lib "wininet.dll" Alias "InternetCrackUrlA" (ByVal lpszUrl As String, ByVal dwUrlLength As Long, ByVal dwFlags As Long, lpUrlComponents As URL_COMPONENTS) As Long Private Declare Function InternetCanonicalizeUrl Lib "wininet.dll" Alias "InternetCanonicalizeUrlA" (ByVal lpszUrl As String, ByVal lpszBuffer As String, lpdwBufferLength As Long, ByVal dwFlags As Long) As Long Private Declare Function InternetCreateUrl Lib "wininet.dll" Alias "InternetCreateUrlA" (lpUrlComponents As URL_COMPONENTS, ByVal dwFlags As Long, ByVal lpszUrl As String, lpdwUrlLength As Long) As Long Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, 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, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long Public Function URLDecode(ByVal sURL As String, _ Optional ByVal bEncodeSpace As Boolean = False, _ Optional ByVal bUTF8 As Boolean = True) As String Dim tURL_COMPONENTS As URL_COMPONENTS Call CrackUrl(sURL, tURL_COMPONENTS) If bEncodeSpace Then tURL_COMPONENTS.ExtraInfo = Replace(tURL_COMPONENTS.ExtraInfo, "+", " ") End If URLDecode = CreateUrl(tURL_COMPONENTS, False) If bUTF8 Then URLDecode = UTF82Unicode(URLDecode) End If End Function Public Function URLEncode(ByVal sURL As String, _ Optional ByVal bEncodeSpace As Boolean = False, _ Optional ByVal bUTF8 As Boolean = True) As String Dim tURL_COMPONENTS As URL_COMPONENTS If bUTF8 Then sURL = Unicode2UTF8(sURL) End If Call CrackUrl(sURL, tURL_COMPONENTS) URLEncode = CreateUrl(tURL_COMPONENTS, True) If bEncodeSpace Then URLEncode = Replace(URLEncode, "%20", "+") End If End Function Private Function CreateUrl(ByRef tURL_COMPONENTS As URL_COMPONENTS, ByVal bEscape As Boolean) As String Dim sBuffer As String sBuffer = String$(2048, 0) tURL_COMPONENTS.StructSize = Len(tURL_COMPONENTS) If InternetCreateUrl(tURL_COMPONENTS, IIf(bEscape, ICU_ESCAPE, 0), sBuffer, 2048) Then CreateUrl = Left$(sBuffer, lstrlen(sBuffer)) End If End Function Private Sub CrackUrl(ByVal sURL As String, ByRef tURL_COMPONENTS As URL_COMPONENTS) Dim sBuffer As String Dim lSize As Long lSize = 2048 sBuffer = Space$(lSize) If InternetCanonicalizeUrl(sURL, sBuffer, lSize, ICU_BROWSER_MODE) Then sURL = Left$(sBuffer, lstrlen(sBuffer)) With tURL_COMPONENTS .StructSize = Len(tURL_COMPONENTS) .Scheme = Space$(lSize) .SchemeLength = lSize .HostName = Space$(lSize) .HostNameLength = lSize .UserName = Space$(lSize) .UserNameLength = lSize .Password = Space$(lSize) .PasswordLength = lSize .URLPath = Space$(lSize) .UrlPathLength = lSize .ExtraInfo = Space$(lSize) .ExtraInfoLength = lSize End With Call InternetCrackUrl(sURL, Len(sURL), ICU_DECODE, tURL_COMPONENTS) End If End Sub Private Function UTF82Unicode(ByVal sData As String) As String Dim lRet As Long Dim sBuffer As String sBuffer = Space(Len(sData)) lRet = MultiByteToWideChar(CP_UTF8, 0, _ StrPtr(StrConv(sData, vbFromUnicode)), Len(sData), _ StrPtr(sBuffer), Len(sData)) If lRet Then UTF82Unicode = Left$(sBuffer, lRet) End If End Function Private Function Unicode2UTF8(ByVal sData As String) As String Dim lRet As Long Dim sBuffer As String sBuffer = Space(LenB(sData)) lRet = WideCharToMultiByte(CP_UTF8, 0, _ StrPtr(sData), Len(sData), _ StrPtr(sBuffer), Len(sBuffer), _ vbNullString, 0) If lRet Then sBuffer = StrConv(sBuffer, vbUnicode) Unicode2UTF8 = Left$(sBuffer, lRet) End If End Function
|
|
« Última modificación: 21 Diciembre 2012, 13:44 pm por cobein »
|
En línea
|
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Bueno, aquí dejo mi forma de hacerlo. Lo he planteado de una manera un poco diferente y es bastante rápido. Aún así, quizás se podría agilizar aún más con algo de magia negra, pero como la cadena de la url va a ser relativamente corta supongo que no habrá una diferencia muy notable. Si veis cosas a añadir o a mejorar decirlo, aunque creo que se adapta a lo que pide LeandroA en el primer post.
Módulo: Option Explicit '============================================================================ ' º Module : mFastUrlEncode.bas ' º Author : Psyke1 ' º Mail : psyke1@elhacker.net ' º Date : 22/12/2012 ' º Recommended Websites : ' http://foro.h-sec.org ' http://infrangelux.sytes.net '============================================================================ '// msvbvm60.dll Private Declare Sub PutMem4 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByVal Value As Long) '// oleaut32.dll Private Declare Function SysAllocStringByteLen Lib "oleaut32.dll" (ByVal Ptr As Long, ByVal Length As Long) As Long '// kernel32.dll Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long Private Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long Private Const CP_UTF8 As Long = &HFDE9& Private Const STR_VALID_CHARS As String = "QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm1234567890-_.:~%&=" Public Static Function URLEncode(ByVal sUrl As String, _ Optional ByVal bSpacePlus As Boolean, _ Optional ByVal bUTF8 As Boolean = True) As String Dim Q As Long Dim sHex As String Dim sChr As String * &H1 Dim lRet As Long Dim lLen As Long Dim lStart As Long Dim sBuffer As String lLen = LenB(sUrl) If lLen Then lStart = InStrB(&H1, sUrl, "=", vbBinaryCompare) - &H1 If lStart > -&H1 Then lRet = lLen - lStart URLEncode = RightB$(sUrl, lRet) If bUTF8 Then PutMem4 VarPtr(sBuffer), SysAllocStringByteLen(&H0, (lRet + lRet)) lRet = WideCharToMultiByte(CP_UTF8, &H0, _ StrPtr(URLEncode), (lRet \ &H2), _ StrPtr(sBuffer), lRet, _ vbNullString, &H0) URLEncode = LeftB$(StrConv(sBuffer, vbUnicode), (lRet + lRet)) End If Q = &H3 Do While Q < lLen sChr = MidB$(URLEncode, Q, &H2) If sChr = "%" Then Q = Q + &H6 ElseIf InStrB(&H1, STR_VALID_CHARS, sChr, vbBinaryCompare) = &H0 Then sHex = Hex$(AscW(sChr)) If LenB(sHex) < &H4 Then sHex = "0" & sHex URLEncode = Replace$(URLEncode, sChr, ("%" & sHex), , , vbBinaryCompare) lLen = LenB(URLEncode) Q = Q + &H6 Else Q = Q + &H2 End If Loop If bSpacePlus Then URLEncode = Replace$(URLEncode, "%20", "+", , , vbBinaryCompare) End If URLEncode = (LeftB$(sUrl, lStart) & URLEncode) Else URLEncode = sUrl End If End If End Function Public Static Function URLDecode(ByVal sUrl As String, _ Optional ByVal bSpacePlus As Boolean, _ Optional ByVal bUTF8 As Boolean = True) As String Dim sHex As String Dim lPos As Long Dim lLen As Long Dim lStart As Long Dim sBuffer As String If LenB(sUrl) Then lStart = InStrB(&H1, sUrl, "=", vbBinaryCompare) + &H2 URLDecode = sUrl If lStart > &H2 Then lPos = InStrB(lStart, URLDecode, "%", vbBinaryCompare) Do While lPos lPos = lPos + &H2 sHex = MidB$(URLDecode, lPos, &H4) If LenB(sHex) = &H0 Then Exit Do URLDecode = Replace$(URLDecode, ("%" & sHex), ChrW$("&H" & sHex), , , vbBinaryCompare) lPos = InStrB(lPos, URLDecode, "%", vbBinaryCompare) Loop If bSpacePlus Then URLDecode = Replace$(URLDecode, "+", " ", , , vbBinaryCompare) End If If bUTF8 Then lLen = LenB(URLDecode) \ &H2 PutMem4 VarPtr(sBuffer), SysAllocStringByteLen(&H0, lLen + lLen) lLen = MultiByteToWideChar(CP_UTF8, &H0, _ StrPtr(StrConv(URLDecode, vbFromUnicode)), lLen, _ StrPtr(sBuffer), lLen) URLDecode = LeftB$(sBuffer, (lLen + lLen)) End If End If End If End Function
Pruebas: Option Explicit Private Sub Form_Load() Dim vURL As Variant Dim vArr() As Variant Dim sEncodedURL As String vArr() = Array("https://www.google.com.ar/search?q=canción del caballo", _ "http://www.taringa.net/buscar/?q=día 12/12/12&interval=", _ "https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http://mail.live.com/default.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1", _ "https://www.google.com.ar/search?q=casa duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr:1,cd_min:5/12/2012,cd_max:18/12/2012&tbm=isch") Debug.Print Debug.Print String$(15, "-"); Time$; String$(227, "-") For Each vURL In vArr Debug.Print String$(250, "=") Debug.Print "Original :", vURL sEncodedURL = URLEncode(vURL) Debug.Print "Enc&Dec :", URLDecode(sEncodedURL) Debug.Print "Enc :", sEncodedURL sEncodedURL = URLEncode(vURL, True) Debug.Print "Enc&Dec+ :", URLDecode(sEncodedURL, True) Debug.Print "Enc+ :", sEncodedURL Next vURL Debug.Print String$(250, "=") End Sub
Resultado: ---------------01:55:53----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ========================================================================================================================================================================================================================================================== Original : https://www.google.com.ar/search?q=canción del caballo Enc&Dec : https://www.google.com.ar/search?q=canción del caballo Enc : https://www.google.com.ar/search?q=canci%C3%B3n%20del%20caballo Enc&Dec+ : https://www.google.com.ar/search?q=canción del caballo Enc+ : https://www.google.com.ar/search?q=canci%C3%B3n+del+caballo ========================================================================================================================================================================================================================================================== Original : http://www.taringa.net/buscar/?q=día 12/12/12&interval= Enc&Dec : http://www.taringa.net/buscar/?q=día 12/12/12&interval= Enc : http://www.taringa.net/buscar/?q=d%C3%ADa%2012%2F12%2F12&interval= Enc&Dec+ : http://www.taringa.net/buscar/?q=día 12/12/12&interval= Enc+ : http://www.taringa.net/buscar/?q=d%C3%ADa+12%2F12%2F12&interval= ========================================================================================================================================================================================================================================================== Original : https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http://mail.live.com/default.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1 Enc&Dec : https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http://mail.live.com/default.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1 Enc : https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http%3A%2F%2Fmail.live.com%2Fdefault.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1 Enc&Dec+ : https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http://mail.live.com/default.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1 Enc+ : https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http%3A%2F%2Fmail.live.com%2Fdefault.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1 ========================================================================================================================================================================================================================================================== Original : https://www.google.com.ar/search?q=casa duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr:1,cd_min:5/12/2012,cd_max:18/12/2012&tbm=isch Enc&Dec : https://www.google.com.ar/search?q=casa duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr:1,cd_min:5/12/2012,cd_max:18/12/2012&tbm=isch Enc : https://www.google.com.ar/search?q=casa%20duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr%3A1%2Ccd_min%3A5%2F12%2F2012%2Ccd_max%3A18%2F12%2F2012&tbm=isch Enc&Dec+ : https://www.google.com.ar/search?q=casa duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr:1,cd_min:5/12/2012,cd_max:18/12/2012&tbm=isch Enc+ : https://www.google.com.ar/search?q=casa+duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr%3A1%2Ccd_min%3A5%2F12%2F2012%2Ccd_max%3A18%2F12%2F2012&tbm=isch ==========================================================================================================================================================================================================================================================
DoEvents!
|
|
« Última modificación: 24 Diciembre 2012, 16:58 pm por Psyke1 »
|
En línea
|
|
|
|
Danyfirex
Desconectado
Mensajes: 493
My Dear Mizuho
|
@Psyke1 tu codigo no simula bien lo de la pagina. hace falta convertirla cadena a UTF8. debe imprimirlo así: cobein https://www.google.com.ar/search?q=canci%C3%B3n
el tuyo lo deja así: Psyke1 https://www.google.com.ar/search?q=canci%F3n
saludos
|
|
|
En línea
|
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Ok, se me escapó. Gracias, ya lo he corregido. Ahora tan sólo queda hacer los test con CTiming. DoEvents!
|
|
« Última modificación: 23 Diciembre 2012, 02:07 am por Psyke1 »
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
Reto ;)
Ingeniería Inversa
|
NeoKiller
|
3
|
3,201
|
15 Agosto 2004, 23:12 pm
por NeoKiller
|
|
|
Reto!!
Ingeniería Inversa
|
HaCkZaTaN
|
2
|
3,215
|
10 Septiembre 2004, 09:30 am
por Ðevastador
|
|
|
eval(gzinflate(base64_decode(urldecode
PHP
|
luiggy2
|
8
|
9,054
|
16 Junio 2008, 23:30 pm
por WHK
|
|
|
Alguien me puede ayudar con la funcion URLENCODE?
PHP
|
TrashAmbishion
|
1
|
3,907
|
24 Agosto 2011, 22:54 pm
por WHK
|
|
|
[Pregunta]: urlencode se usa para codificar toda una url o una parte?
Desarrollo Web
|
Leguim
|
1
|
2,172
|
16 Enero 2020, 18:58 pm
por engel lex
|
|