Foro de elhacker.net

Private Const CP_UTF8 = 65001

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 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 Long, ByVal lpUsedDefaultChar As Long) As Long

Public Function UTF8_Encode(ByVal Text As String) As String

Dim sBuffer As String
Dim lLength As Long

If Text <> "" Then
lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(Text), -1, 0, 0, 0, 0)
sBuffer = Space$(lLength)
lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(Text), -1, StrPtr(sBuffer), Len(sBuffer), 0, 0)
sBuffer = StrConv(sBuffer, vbUnicode)
UTF8_Encode = Left$(sBuffer, lLength - 1)
Else
UTF8_Encode = ""
End If

End Function

Private Sub Form_Load()
Debug.Print UTF8_Encode("D:\Mis documentos\Mi música")
End Sub

Private Function UTF8_Encode(ByVal sStr As String)
For l& = 1 To Len(sStr)
lChar& = AscW(Mid(sStr, l&, 1))
If lChar& < 128 Then
sUtf8$ = sUtf8$ + Mid(sStr, l&, 1)
ElseIf ((lChar& > 127) And (lChar& < 2048)) Then
sUtf8$ = sUtf8$ + Chr(((lChar& \ 64) Or 192))
sUtf8$ = sUtf8$ + Chr(((lChar& And 63) Or 128))
Else
sUtf8$ = sUtf8$ + Chr(((lChar& \ 144) Or 234))
sUtf8$ = sUtf8$ + Chr((((lChar& \ 64) And 63) Or 128))
sUtf8$ = sUtf8$ + Chr(((lChar& And 63) Or 128))
End If
Next l&
UTF8_Encode = sUtf8$
End Function

Private Sub Form_Load()
MsgBox UTF8_Encode("D:\Mis documentos\Mi música")
End Sub