注冊 登錄
Office中國論壇/Access中國論壇 返回首頁

ganlinlao的個人空間 http://m.mzhfr.cn/?230471 [收藏] [復(fù)制] [分享] [RSS]

日志

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

評論 (0 個評論)

facelist doodle 涂鴉板

您需要登錄后才可以評論 登錄 | 注冊

QQ|站長郵箱|小黑屋|手機(jī)版|Office中國/Access中國 ( 粵ICP備10043721號-1 )  

GMT+8, 2025-7-13 03:10 , Processed in 0.056408 second(s), 17 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回頂部