segunda-feira, 26 de julho de 2010

Função Escape

Retorna uma string codificada

Function RemoveCaracteresEspeciaisWeb(qString) As String
tempText = qString
arrayCharTrash = Split("%E1,%E2,%E3,%C1,%C2,%C3,%C9,%E9,%EA,%CD,%ED,%D3,%D4,%D5,%F3,%F5,%F4,%DA,%DC,%FA,%FC,%E7,%C7,%20,%23",",")
arrayCharOk = Split("á,â,ã,Á,Â,Ã,É,é,ê,Í,í,Ó,Ô,Õ,ó,õ,ô,Ú,Ü,ú,ü,ç,Ç, ,#",",")
For i = 0 To Ubound(arrayCharTrash)
tempText = Replace(tempText,arrayCharTrash(i),arrayCharOk(i))
Next
RemoveCaracteresEspeciaisWeb = tempText
End Function



Function LSescape(strIn As String) As String
Dim strAllowed As String
Dim i As Integer
Dim strChar As String
Dim strReturn As String

'These are the characters that the JavaScript escape-function allows,
'so we let them pass unchanged in this function as well.
strAllowed = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" & "@/.*-_"
i = 1
strReturn = ""
While Not (i > Len(strIn))
strChar = Mid$(strIn, i, 1)
If Instr(1, strAllowed, strChar) > 0 Then
strReturn = strReturn & strChar
Else
strReturn = strReturn & "%" & Hex$(Asc(strChar))
End If
i = i + 1
Wend
LSescape = strReturn
End Function


Function Escape(s As String) As String
%REM
Encodes a string to the "x-www-form-urlencoded" form, enhanced with the UTF-8-in-URL proposal. This is the official
standard to encode URL's to support any possible character set (all Unicode characters).
%END REM
 Dim result As String
 Dim i As Integer
 Dim c As Long
 
 For i = 1 To Len(s)
  c = Uni(Mid$(s, i, 1))
  If c = Uni(" ") Then
   result = result + "+"
  Elseif (c>=Uni("A") And c<=Uni("Z")) Or (c>=Uni("a") And c<=Uni("z")) Or (c>=Uni("0") And c<=Uni("9")) Then
   result = result + Uchr(c)
  Elseif c <= &H007f Then
   result = result + "%" + Hex$(c)
  Elseif c <= &H07FF Then
   result = result + "%" + Hex$(&Hc0 Or (c\64))
   result = result + "%" + Hex$(&H80 Or (c And &h3F))
  Else
   result = result + "%" + Hex$(&Hc0 Or (c\4096))
   result = result + "%" + Hex$(&H80 Or ((c\64) And &H3F))
   result = result + "%" + Hex$(&H80 Or (c And &H3F))
  End If
 Next
 Escape = result
End Function

Nenhum comentário:

Postar um comentário