Utf-8与ANSI编码格式互相转换

SKY定格

1. Option Explicit
   
2. Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
   
3. Private Const CP_UTF8 = 65001
   
4. '读文件至变量
   
5. Private Function GetFile(FileName As String) As String
   
6. Dim i As Integer, BB() As Byte
   
7.     If Dir(FileName) = "" Then Exit Function
   
8.     i = FreeFile
   
9.     ReDim BB(FileLen(FileName) - 1)
   
10.     Open FileName For Binary As #i
    
11.     Get #i, , BB
    
12.     Close #i
    
13.     GetFile = BB
    
14. End Function
    
15. '功能: 把Utf8字符转化成ANSI字符
    
16. Public Function UTF8_Decode(FileName As String) As String
    
17. Dim sUTF8 As String
    
18. Dim lngUtf8Size As Long
    
19. Dim strBuffer As String
    
20. Dim lngBufferSize As Long
    
21. Dim lngResult As Long
    
22. Dim bytUtf8() As Byte
    
23. Dim n As Long
    
24.     sUTF8 = GetFile(FileName)
    
25.     If LenB(sUTF8) = 0 Then Exit Function
    
26.     On Error GoTo EndFunction
    
27.     bytUtf8 = sUTF8
    
28.     lngUtf8Size = UBound(bytUtf8) + 1
    
29.     lngBufferSize = lngUtf8Size * 2
    
30.     strBuffer = String$(lngBufferSize, vbNullChar)
    
31.     lngResult = MultiByteToWideChar(CP_UTF8, 0, bytUtf8(0), _
    
32.             lngUtf8Size, StrPtr(strBuffer), lngBufferSize)
    
33.     If lngResult Then
    
34.         UTF8_Decode = Left(strBuffer, lngResult)
    
35.     End If
    
36. EndFunction:
    
37.   
    
38. End Function

复制代码

二、调用举例：
如果你想把一个"c:\1.txt"的UTF-8文件转换为ANSI编码，可这样调用
dim s as string
s=UTF8_Decode("c:\1.txt") '文件名请根据实际修改
此时，s存放的就是ANSI格式编码了，不会出现乱码问题锦葵科
   下面的是ansi转换utf-8

1. Private Sub Command4_Click()s = "C:\Documents and Settings\Administrator\桌面\素材\2.xml"
   
2. ToUtf8 s, "c:\ab.xml"
   
3. MsgBox "ok"
   
4. End Sub
   
5. Private Sub ToUtf8(ByVal s As String, ByVal FilePath As String)
   
6. Dim stmStr
   
7. Set stmStr = CreateObject("ADODB.Stream")
   
8. stmStr.Open
   
9. stmStr.Charset = "utf-8"
   
10. stmStr.WriteText s
    
11. stmStr.SaveToFile FilePath
    
12. stmStr.Close
    
13. Set stmStr = Nothing
    
14. End Sub
    

复制代码

fieldmax

我顶你