• 博客园logo
  • 会员
  • 众包
  • 新闻
  • 博问
  • 闪存
  • 赞助商
  • HarmonyOS
  • Chat2DB
    • 搜索
      所有博客
    • 搜索
      当前博客
  • 写随笔 我的博客 短消息 简洁模式
    用户头像
    我的博客 我的园子 账号设置 会员中心 简洁模式 ... 退出登录
    注册 登录
人生之路,职业之路
读书使人充实,交谈使人机敏,写记使人精确;
“动因+兴趣”——决心-持之以恒-见效
博客园    首页    新随笔    联系   管理    订阅  订阅
(原创)vbscript 字符串处理函数

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

'截取指定长度的字符串(两个字母计成一个字符)
'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

 

 

posted on 2008-09-26 17:22  FreeBird  阅读(589)  评论(0)    收藏  举报
刷新页面返回顶部
博客园  ©  2004-2025
浙公网安备 33010602011771号 浙ICP备2021040463号-3