VBS字符串编码转换函数代码

1. ANSI 转 UTF-8

' ANSI 转 UTF-8
Function ANSIToUTF8(str)
    Dim stream
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 2  ' 文本类型
    stream.Charset = "GB2312"  ' ANSI编码（根据实际情况调整，如GBK）
    stream.Open
    stream.WriteText str
    stream.Position = 0
    stream.Charset = "UTF-8"
    ANSIToUTF8 = stream.ReadText
    stream.Close
    Set stream = Nothing
End Function

2. UTF-8 转 ANSI

' UTF-8 转 ANSI
Function UTF8ToANSI(str)
    Dim stream
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 2  ' 文本类型
    stream.Charset = "UTF-8"
    stream.Open
    stream.WriteText str
    stream.Position = 0
    stream.Charset = "GB2312"  ' ANSI编码（根据实际情况调整）
    UTF8ToANSI = stream.ReadText
    stream.Close
    Set stream = Nothing
End Function

3. 通用的编码转换函数

' 通用编码转换函数
Function ConvertEncoding(str, fromCharset, toCharset)
    Dim stream
    Set stream = CreateObject("ADODB.Stream")

    stream.Type = 2  ' 文本类型
    stream.Charset = fromCharset
    stream.Open
    stream.WriteText str
    stream.Position = 0
    stream.Charset = toCharset
    ConvertEncoding = stream.ReadText

    stream.Close
    Set stream = Nothing
End Function

' 使用示例：
' UTF-8 转 GB2312
' result = ConvertEncoding(str, "UTF-8", "GB2312")
'
' GB2312 转 UTF-8
' result = ConvertEncoding(str, "GB2312", "UTF-8")
'
' UTF-8 转 GBK
' result = ConvertEncoding(str, "UTF-8", "GBK")

4. 处理文件编码转换

' 读取UTF-8文件（无BOM）
Function ReadUTF8FileWithoutBOM(filePath)
    Dim stream, content
    Set stream = CreateObject("ADODB.Stream")

    stream.Type = 1  ' 二进制类型
    stream.Open
    stream.LoadFromFile filePath

    ' 转换为文本
    stream.Position = 0
    stream.Type = 2  ' 文本类型
    stream.Charset = "UTF-8"
    content = stream.ReadText

    stream.Close
    Set stream = Nothing

    ReadUTF8FileWithoutBOM = content
End Function

' 保存为UTF-8文件（带BOM）
Sub SaveAsUTF8WithBOM(filePath, content)
    Dim stream
    Set stream = CreateObject("ADODB.Stream")

    ' 写入UTF-8内容（会包含BOM）
    stream.Type = 2  ' 文本类型
    stream.Charset = "UTF-8"
    stream.Open
    stream.WriteText content

    ' 保存文件
    stream.Position = 0
    stream.Type = 1  ' 二进制类型
    stream.SaveToFile filePath, 2  ' 2=覆盖

    stream.Close
    Set stream = Nothing
End Sub

5. URL编码解码

' URL编码
Function URLEncode(str)
    URLEncode = Replace(str, " ", "+")  ' 简单处理
    ' 或使用更全面的方法
    Dim i, ch, hexVal
    For i = 1 To Len(str)
        ch = Mid(str, i, 1)
        If AscW(ch) < 0 Then AscW(ch) = AscW(ch) + 65536
        If (ch >= "0" And ch <= "9") Or _
           (ch >= "A" And ch <= "Z") Or _
           (ch >= "a" And ch <= "z") Or _
           ch = "-" Or ch = "_" Or ch = "." Or ch = "~" Then
            URLEncode = URLEncode & ch
        Else
            hexVal = Hex(AscW(ch))
            If Len(hexVal) < 4 Then hexVal = String(4 - Len(hexVal), "0") & hexVal
            URLEncode = URLEncode & "%" & hexVal
        End If
    Next
End Function

' URL解码
Function URLDecode(str)
    str = Replace(str, "+", " ")
    Dim i, ch, hexStr
    i = 1
    Do While i <= Len(str)
        ch = Mid(str, i, 1)
        If ch = "%" And i + 2 <= Len(str) Then
            hexStr = Mid(str, i + 1, 2)
            If IsHex(hexStr) Then
                URLDecode = URLDecode & Chr("&H" & hexStr)
                i = i + 3
            Else
                URLDecode = URLDecode & ch
                i = i + 1
            End If
        Else
            URLDecode = URLDecode & ch
            i = i + 1
        End If
    Loop
End Function

' 辅助函数：检查是否为十六进制字符串
Function IsHex(str)
    Dim i, ch
    IsHex = True
    For i = 1 To Len(str)
        ch = UCase(Mid(str, i, 1))
        If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "F")) Then
            IsHex = False
            Exit For
        End If
    Next
End Function

6. Base64编码解码

' Base64编码
Function Base64Encode(str)
    Dim xml, node
    Set xml = CreateObject("MSXML2.DOMDocument")
    Set node = xml.createElement("b64")
    node.DataType = "bin.base64"
    node.nodeTypedValue = Stream_StringToBinary(str)
    Base64Encode = node.text
End Function

' Base64解码
Function Base64Decode(base64)
    Dim xml, node
    Set xml = CreateObject("MSXML2.DOMDocument")
    Set node = xml.createElement("b64")
    node.DataType = "bin.base64"
    node.text = base64
    Base64Decode = Stream_BinaryToString(node.nodeTypedValue)
End Function

' 辅助函数：字符串转二进制
Function Stream_StringToBinary(str)
    Dim stream
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 2  ' 文本类型
    stream.Charset = "UTF-8"
    stream.Open
    stream.WriteText str
    stream.Position = 0
    stream.Type = 1  ' 二进制类型
    Stream_StringToBinary = stream.Read
    stream.Close
End Function

' 辅助函数：二进制转字符串
Function Stream_BinaryToString(bin)
    Dim stream
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 1  ' 二进制类型
    stream.Open
    stream.Write bin
    stream.Position = 0
    stream.Type = 2  ' 文本类型
    stream.Charset = "UTF-8"
    Stream_BinaryToString = stream.ReadText
    stream.Close
End Function

使用示例：

' 测试编码转换
Dim original, converted

original = "你好，世界！"

' UTF-8 转 GB2312
converted = ConvertEncoding(original, "UTF-8", "GB2312")
WScript.Echo "UTF-8 -> GB2312: " & converted

' GB2312 转 UTF-8
converted = ConvertEncoding(original, "GB2312", "UTF-8")
WScript.Echo "GB2312 -> UTF-8: " & converted

' URL编码
WScript.Echo "URL编码: " & URLEncode(original)

' Base64编码
WScript.Echo "Base64编码: " & Base64Encode(original)

注意事项：

这些函数可以满足VBScript中常见的字符串编码转换需求。