Internett: www.wis.no E-post: wis@wis.no
Tlf: 7245 0190 Fax: 7245 0191

Startsiden | Produkter | Drift | Markedsføring | Ta kontakt | Gå til
Søk:
Logg innLogg inn 

WIS blogg


VBA UrlEncode
Av: Ove Halseth Lørdag 30.10.2010 (22:43)

I ett prosjekt så hadde vi behov for å poste en url. Problemet var bare at æøå rotet til alt på serversiden, og vi fikk ikke ut parametrene.

Etter litt googling så fant vi fort diverse varianter av UrlEncode, deriblandt en versjon som skulle støtte UTF-8:

http://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba

Men vi kom ikke helt i mål, for vi fikk ikke konverteringen til UTF-8 til å virke:-( Nytt dykk i google kom opp med:

http://www.codenewsgroups.net/vb/t13396-widechartomultibyte-utf-8.aspx

Som ga oss konvertering til UTF-8.

Resultatet ble:


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 String, ByVal cbMultiByte As Long, _
    ByVal lpDefaultChar As String, ByRef lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "Kernel32.dll" ( _
    ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, _
    ByVal cbMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

Private Const CP_UTF8 As Long = 65001   ' UTF-8 translation

Public Function ToUTF8(ByRef inString As String) As String
    Dim BufLen As Long

    BufLen = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(inString), _
        Len(inString), vbNullString, 0&, vbNullString, ByVal 0&)
    If (BufLen > 0) Then
        ToUTF8 = Space$(BufLen)
        Call WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(inString), _
            Len(inString), ToUTF8, BufLen, vbNullString, ByVal 0&)
    End If
End Function

Public Function FromUTF8(ByRef inString As String) As String
    Dim BufLen As Long

    BufLen = MultiByteToWideChar(CP_UTF8, 0&, inString, -1, 0&, 0&)
    If (BufLen > 0) Then
        FromUTF8 = Space$(BufLen)
        BufLen = MultiByteToWideChar(CP_UTF8, 0&, inString, _
            Len(inString), ByVal StrPtr(FromUTF8), BufLen)
        FromUTF8 = Left$(FromUTF8, BufLen) ' Trim null
    End If
End Function

 

Public Function UrlEncode( _
   StringVal As String, _
   Optional SpaceAsPlus As Boolean = False, _
   Optional UTF8Encode As Boolean = True _
) As String
 
Dim StringValCopy As String
Dim StringLen As Long

StringValCopy = IIf(UTF8Encode, ToUTF8(StringVal), StringVal)
StringLen = Len(StringValCopy)

If StringLen > 0 Then
    ReDim Result(StringLen) As String
    Dim I As Long, CharCode As Integer
    Dim Char As String, Space As String
 
  If SpaceAsPlus Then Space = "+" Else Space = "%20"
 
  For I = 1 To StringLen
    Char = Mid$(StringValCopy, I, 1)
    CharCode = Asc(Char)
    Select Case CharCode
      Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
        Result(I) = Char
      Case 32
        Result(I) = Space
      Case 0 To 15
        Result(I) = "%0" & Hex(CharCode)
      Case Else
        Result(I) = "%" & Hex(CharCode)
    End Select
  Next I
  UrlEncode = Join(Result, "")
 
End If
End Function


'From http://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba
Public Function UrlEncode( _
   StringVal As String, _
   Optional SpaceAsPlus As Boolean = False, _
   Optional UTF8Encode As Boolean = True _
) As String
 
Dim StringValCopy As String
Dim StringLen As Long

StringValCopy = IIf(UTF8Encode, ToUTF8(StringVal), StringVal)
StringLen = Len(StringValCopy)

If StringLen > 0 Then
    ReDim Result(StringLen) As String
    Dim I As Long, CharCode As Integer
    Dim Char As String, Space As String
 
  If SpaceAsPlus Then Space = "+" Else Space = "%20"
 
  For I = 1 To StringLen
    Char = Mid$(StringValCopy, I, 1)
    CharCode = Asc(Char)
    Select Case CharCode
      Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
        Result(I) = Char
      Case 32
        Result(I) = Space
      Case 0 To 15
        Result(I) = "%0" & Hex(CharCode)
      Case Else
        Result(I) = "%" & Hex(CharCode)
    End Select
  Next I
  UrlEncode = Join(Result, "")
 
End If
End Function

 

Ove B-)

--Emner: Access, Utvikling, VBA
Kommentarer: 0


 
 Nye poster
Fixing missing (30.05.2012)
Redirect dll us (30.05.2012)
Laste ned passo (11.05.2012)
Bare si "Nei ti (12.12.2011)
Posten er slett (16.11.2011)
 Søk
 
 Populære emner
Access  Ajax  Ansatte  Brannmur  Database/SQL  Debugging  Delphi  FortiClient  Fortigate  GSI  Hjemmet  Html  Internett  iPhone  iPhone Apps  Java  JavaScript  JVM  Nerdehumor  Nettverk  Operativsystem  Palm  Servere  Skrivere  Sybase  Utvikling  VBA  Vista  VPN  Web 2.0  Windows  WinXP  WIS  Wis Tiltak  WisWeb 1  WisWeb 2  Word  XML
 Vis måned
Mai 2012 (3)
Desember 2011 (1)
November 2011 (1)
September 2011 (2)
August 2011 (1)
 Vis fra forfatter
Ove Halseth (46)
Dag Waade (9)
Stig Runar Vangen (7)
Svein Waade (6)
Inge Valaas (1)
Inger Berg (1)
Kristian Ljøkelsøy Vitsø (1)