FreeBasic的ansii,utf8,unicode互轉(zhuǎn)碼函數(shù)
已有 2405 次閱讀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 ' // 循環(huán)計(jì)數(shù)
Dim Strascii As String ' // Ascii 字符串
Dim Idx As Long ' // 單字在字符串位置
Dim C As Long ' // Ascii 碼
Dim B2 As Long ' // 第二字節(jié)
Dim Fskipchar As Boolean ' // 標(biāo)記
If Len(Strutf8) = 0 Then Exit Function
' // 轉(zhuǎn)碼的字符串大小與原始字符串大小是相同的
' // 預(yù)先分配字符串內(nèi)存比每一次把每個字符串拼接起來要快得多
Strascii = Space(Len(Strutf8))
' // 先標(biāo)記好字符在字符串的位置,用來保存轉(zhuǎn)碼的字符
Idx = 1
For I = 1 To Len(Strutf8)
' // 如果 Fskipchar 非0,將跳過這個字符(因?yàn)橛⑽氖菃巫止?jié),中文是雙字節(jié)的)
If Fskipchar Then
Fskipchar = 0
Continue For
End If
' // 返回字符的asci碼
C = Asc(Mid(Strutf8, I, 1))
' // 0-127...
If C < 128 Then
' // ...簡單復(fù)制過來...
Mid(Strascii, Idx, 1) = Mid(Strutf8, Idx, 1)
' // ...并遞增字符位置.
Idx = Idx + 1
Elseif C < 224 Then
' // 將非單字節(jié)的字符進(jìn)行合并.
B2 = Asc(Mid(Strutf8, I + 1, 1))
If B2 > 127 Then
C = (C - 192) * 64 + (B2 - 128)
Mid(Strascii, Idx, 1) = Chr(C)
' // 合并完后,設(shè)置Fskipchar為非零,跳過下一個字節(jié)
Fskipchar = True
' // 遞增字符位置+1
Idx = Idx + 1
End If
End If
Next
' // 返回轉(zhuǎn)完碼的字符串
Function = Left(Strascii, Idx - 1)
End Function
' ==================================================
'==================================================
Function Ansitoutf8(Byref Sansi As String) As String
Dim Sunicode As String
Dim Sutf8 As String
'將ansi字符串轉(zhuǎn)為utf8.
'第一步,將ansi轉(zhuǎn)為unicode
Sunicode = String(Len(Sansi) * 2, 0)
Multibytetowidechar(Cp_acp, _ '設(shè)成默認(rèn)的頁代碼
Mb_precomposed, _ '轉(zhuǎn)換類型
Cast(Lpcstr, Strptr(Sansi)), _ '原始的ansi字符串
Len(Sansi), _ 'ansi字符串大小
Cast(Lpwstr, Strptr(Sunicode)), _ 'unicode 字符串
Len(Sunicode)) 'Unicode字符串大小
'轉(zhuǎn)成utf-8
Sutf8 = String(Len(Sansi), 0)
Widechartomultibyte(Cp_utf8, _ '設(shè)成 Utf-8
0, _ '轉(zhuǎn)換類型
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, _ '設(shè)為 Utf-8
0, _ '轉(zhuǎn)換類型
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 '這個有點(diǎn)神奇
Function= True: Exit For
End If
Next
End Function