FreeBasic的ansii,utf8,unicode互转码函数
已有 2277 次阅读2017-4-26 10:42
|个人分类:FreeBasic
Declare Function Utf8toascii(Byref Strutf8 As String) As String
Declare Function Ansitoutf8(Byref Sansi As String) As String
Declare Function Utf8tounicode(Byref Ansistr As Const String) As String
Declare Function Unicodetoutf8(Byval Pswzunicode As Wstring Ptr) As String
Function isUtf8( Byref sText As String) As Boolean
'=========================================
Function Utf8toascii(Byref Strutf8 As String) As String
Dim I As Long ' // 循环计数
Dim Strascii As String ' // Ascii 字符串
Dim Idx As Long ' // 单字在字符串位置
Dim C As Long ' // Ascii 码
Dim B2 As Long ' // 第二字节
Dim Fskipchar As Boolean ' // 标记
If Len(Strutf8) = 0 Then Exit Function
' // 转码的字符串大小与原始字符串大小是相同的
' // 预先分配字符串内存比每一次把每个字符串拼接起来要快得多
Strascii = Space(Len(Strutf8))
' // 先标记好字符在字符串的位置,用来保存转码的字符
Idx = 1
For I = 1 To Len(Strutf8)
' // 如果 Fskipchar 非0,将跳过这个字符(因为英文是单字节,中文是双字节的)
If Fskipchar Then
Fskipchar = 0
Continue For
End If
' // 返回字符的asci码
C = Asc(Mid(Strutf8, I, 1))
' // 0-127...
If C < 128 Then
' // ...简单复制过来...
Mid(Strascii, Idx, 1) = Mid(Strutf8, Idx, 1)
' // ...并递增字符位置.
Idx = Idx + 1
Elseif C < 224 Then
' // 将非单字节的字符进行合并.
B2 = Asc(Mid(Strutf8, I + 1, 1))
If B2 > 127 Then
C = (C - 192) * 64 + (B2 - 128)
Mid(Strascii, Idx, 1) = Chr(C)
' // 合并完后,设置Fskipchar为非零,跳过下一个字节
Fskipchar = True
' // 递增字符位置+1
Idx = Idx + 1
End If
End If
Next
' // 返回转完码的字符串
Function = Left(Strascii, Idx - 1)
End Function
' ==================================================
'==================================================
Function Ansitoutf8(Byref Sansi As String) As String
Dim Sunicode As String
Dim Sutf8 As String
'将ansi字符串转为utf8.
'第一步,将ansi转为unicode
Sunicode = String(Len(Sansi) * 2, 0)
Multibytetowidechar(Cp_acp, _ '设成默认的页代码
Mb_precomposed, _ '转换类型
Cast(Lpcstr, Strptr(Sansi)), _ '原始的ansi字符串
Len(Sansi), _ 'ansi字符串大小
Cast(Lpwstr, Strptr(Sunicode)), _ 'unicode 字符串
Len(Sunicode)) 'Unicode字符串大小
'转成utf-8
Sutf8 = String(Len(Sansi), 0)
Widechartomultibyte(Cp_utf8, _ '设成 Utf-8
0, _ '转换类型
Cast(Lpcwstr, Strptr(Sunicode)), _ '原始的unicode字符串
Len(Sunicode) / 2, _ 'unicode字符大小
Cast(Lpstr, Strptr(Sutf8)), _ 'utf-8 字符串
Len(Sutf8), _ 'Utf-8字符串大小
Byval 0, _
Byval 0)
Function = Sutf8
End Function
' =====================================================
' ====================================================
Function Utf8tounicode(Byref Ansistr As Const String) As String
Dim Dwlen As Dword = Multibytetowidechar(Cp_utf8, 0, Strptr(Ansistr), Len(Ansistr), Null, 0)
If Dwlen Then
Dim S As String = Space(Dwlen * 2)
Dwlen = Multibytetowidechar(Cp_utf8, 0, Strptr(Ansistr), Len(Ansistr), Cast(Wstring Ptr, Strptr(S)), Dwlen * 2)
If Dwlen Then Return S
End If
End Function
' ======================================================
' ======================================================
Function Unicodetoutf8(Byval Pswzunicode As Wstring Ptr) As String
Dim Sutf8 As String
Sutf8 = String(Len(*Pswzunicode), 0)
Widechartomultibyte(Cp_utf8, _ '设为 Utf-8
0, _ '转换类型
Cast(Lpcwstr, Pswzunicode), _ '原始的unicode字符串
Len(*Pswzunicode), _ 'Unicode 字符串长度
Cast(Lpstr, Strptr(Sutf8)), _ 'utf-8 字符串
Len(Sutf8), _ 'utf-8长度
Byval 0, _
Byval 0)
Function = Sutf8
End Function
'==================================
'==================================
'判断字符串是ansi还是utf8(无bom)。
Function isUtf8( Byref sText As String) As Boolean
For I As Long = 0 To Len(sText) - 1
If Bit(sText[I], 7) Then '这个有点神奇
Function= True: Exit For
End If
Next
End Function