如何将GBK编码的XML文件转成utf-8？高分在线急求！

ineedchrist 2005-11-23 01:41:42

已知现有一个GBK编码的xml文件，例子http://www.awaman.com/testXML.rar,如何转换成utf-8的？最好能给出代码，谢谢。

...全文

982 6 打赏收藏转发到动态举报

写回复

用AI写文章

6 条回复

切换为时间正序

请发表友善的回复…

发表回复

ineedchrist 2005-11-28

打赏
举报

谁说我不厚道！！！
^-^
private sub cmdTest_click()
dim sStr as string
Open App.Path & "\Model\head" For Input As #1
Input #1, sStr
Close #1
Call SaveToUTF8(sStr)
end sub

Private Sub SaveToUTF8(sStr as string)
On Error GoTo OutError
Dim DAT() As Byte, DAT1() As Byte, ST As String
Dim Z As String
Dim zTem As String
Dim zCod As String
Dim zHex As String
Dim zBin As String
Dim zRes As Long
Dim zAsc As Long
Dim L As Long, 字节计数
Dim i1 As Long
Dim i2 As Integer
Dim sFileName As String

For i1 = 1 To Len(sStr)
Z = Mid(sStr, i1, 1): zAsc = Asc(Z)
If zAsc > 0 Then '如果不是汉字
ReDim Preserve DAT(L + 1) As Byte
DAT(L) = zAsc: L = L + 1
Else
ReDim Preserve DAT(L + 3) As Byte
DAT1 = Z: ST = Right("0" & Hex(DAT1(1)), 2) & Right("0" & Hex(DAT1(0)), 2)
For i2 = 1 To Len(ST)
Z = Mid(ST, i2, 1)
Select Case Z '将汉字的16进制Unicode编码转换为二进制的
Case Is = "0": zBin = zBin & "0000"
Case Is = "1": zBin = zBin & "0001"
Case Is = "2": zBin = zBin & "0010"
Case Is = "3": zBin = zBin & "0011"
Case Is = "4": zBin = zBin & "0100"
Case Is = "5": zBin = zBin & "0101"
Case Is = "6": zBin = zBin & "0110"
Case Is = "7": zBin = zBin & "0111"
Case Is = "8": zBin = zBin & "1000"
Case Is = "9": zBin = zBin & "1001"
Case Is = "A": zBin = zBin & "1010"
Case Is = "B": zBin = zBin & "1011"
Case Is = "C": zBin = zBin & "1100"
Case Is = "D": zBin = zBin & "1101"
Case Is = "E": zBin = zBin & "1110"
Case Is = "F": zBin = zBin & "1111"
End Select
Next
zTem = "1110" & Left(zBin, 4) & "10" & Mid(zBin, 5, 6) & "10" & Right(zBin, 6)
For i2 = 1 To 24
Z = Mid(zTem, i2, 1)
zRes = zRes + IIf(Z = "1", 1 * 2 ^ (24 - i2), 0 * 2 ^ (24 - i2))
Next
Z = Hex(zRes) '汉字已转换为3字节的16进制数据
DAT(L) = val("&H" & Left(Z, 2))
DAT(L + 1) = val("&H" & Mid(Z, 3, 2))
DAT(L + 2) = val("&H" & Right(Z, 2))
L = L + 3
End If
zBin = "": zRes = 0
Next
ReDim DAT1(2) As Byte
DAT1(0) = &HEF: DAT1(1) = &HBB: DAT1(2) = &HBF

CdlgEOP.filename = ""
CdlgEOP.ShowOpen

sFileName = Trim(CdlgEOP.filename)
If sFileName = "" Then Exit Sub
DAT(UBound(DAT)) = 32

Open sFileName For Binary As #1
Put #1, , DAT1
Put #1, , DAT
Close #1
OutError:
Close
End Sub