注册 登录
Office中国论坛/Access中国论坛 返回首页

ganlinlao的个人空间 http://www.office-cn.net/?230471 [收藏] [复制] [分享] [RSS]

日志

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

评论 (0 个评论)

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-25 07:34 , Processed in 0.054620 second(s), 17 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回顶部