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-)
|
