'**************************************************

'截取指定长度的字符串(两个字母计成一个字符)
'str - 原始字符串,
'lennum - 截取长度,
'chopedString - 省略后面跟的字符串

'**************************************************
Function InterceptString(str,lennum, chopedString)
 Dim orignalLen
 If Len(str) > 0 Then
  orignalLen = Len(str)
  Dim count, i 
  Dim newStr
  newstr = ""
  i = 0
  count = 0
  Do while i < lennum and i < orignalLen  and i < lennum * 2
   i = i + 1
   If Asc(Mid(str,i,1))<0 Then
    count = count + 1
   else
    count = count + 2
   end if
  Loop
  if orignalLen > count Then
   InterceptString = Left(Str, Cint(count)) & chopedString
  else
   InterceptString = Left(Str, Cint(count))
  end if
 Else
  InterceptString=""
 End If
 End Function

 

'GB转UTF8--将GB编码文字转换为UTF8编码文字
Function toUTF8(szInput)
 On Error Resume next
    Dim wch, uch, szRet
    Dim x
    Dim nAsc, nAsc2, nAsc3
    '如果输入参数为空,则退出函数
    If szInput = "" Then
        toUTF8 = szInput
        Exit Function
    End If
    '开始转换
     For x = 1 To Len(szInput)
        '利用mid函数分拆GB编码文字
        wch = Mid(szInput, x, 1)
        '利用ascW函数返回每一个GB编码文字的Unicode字符代码
        '注:asc函数返回的是ANSI 字符代码,注意区别
        nAsc = AscW(wch)
        If nAsc < 0 Then nAsc = nAsc + 65536
   
        If (nAsc And &HFF80) = 0 Then
            szRet = szRet & wch
        Else
            If (nAsc And &HF000) = 0 Then
                uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            Else
               'GB编码文字的Unicode字符代码在0800 - FFFF之间采用三字节模版
                uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
                            Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
                            Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            End If
        End If
    Next
       
    toUTF8 = szRet
End Function

 

 

相关文章:

  • 2021-10-12
  • 2022-12-23
  • 2021-12-12
  • 2021-11-29
  • 2021-06-18
猜你喜欢
  • 2021-04-07
相关资源
相似解决方案