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