ASP中的left-mid-right如何才能区分中文为2个字符英文为1个 - SEO资料站-免费SEO、div+css教程、SEO查询工具及SEO技术研究

■

导航

SEO首页>>>>>>ASP中的left-mid-right如何才能区分中文为2个字符英文为1个

■

ASP中的left-mid-right如何才能区分中文为2个字符英文为1个

ASP中的left-mid-right如何才能区分中文为2个字符英文为1个?
由于我做的ZBLOG插件--列表插件(文章排行)里标题的字数限制,当标题字数太长时,截取前N个字显示,再带个...
可是由于VB里中文英文是一样的长度,没法使用left-mid-right这几个函数来取得一到的标题长度,所以现在的标题长度感觉长短不一,影响美观.

这个问题,我并不是没有看到,而是我没法找到解决方法,试过好多办法,就是没有效果,一些理论上可以做到的,到ZBLOG里就是没用.
如果现在你的ZBLOG急需要解决这个问题,那只能过能CSS来隐藏多出的字的部分了,这个方法你可以去问一下CSS高手,我也不太熟悉,只是以前看过有人发了这样做的文章,没记下来.

我实验过以下几个办法来解决这个问题,都没有成功,但是还是发一下,大家可以一起讨论:
设一下,str为原字符串,outstr为截取后的,counts为设置的字数,使用len以及lenB和left方法
理论上lenB方法取到的中文长度为2,英文长度为1

第一个办法:
先用left方法取counts个字符,使用lenB方法检查取到的字符长度是否为2*counts,如果不是,再用left方法取counts+1个字符,如此循环,直到使用lenB方法检查取到的字符长度是为2*counts结束.
理论上来说,这是对的,可是经过测试,结果还是和直接用left方法取到的是一样的,也就是说,lenB里的英文的长度也是2了,奇怪.我猜测,可能是由于ZBLOG采用UTF-8编码影响的吧.

第二个办法:
自己写一个检查长度的函数,计算长度时,中文为2,英文为1.其它的和方法一是一样的.
函数如下:
Function strLength(str)
Dim WINNT_CHINESE
WINNT_CHINESE=(len("飞鸟")=2)
if WINNT_CHINESE then
dim l,t,c
dim i
l=len(str)
t=l
for i=1 to l
c=asc(mid(str,i,1))
if c<0 then
c=c+65536
end if
if c>255 then
t=t+1
end if
next
strLength=t
else
strLength=len(str)
end if
End Function
这个函数是网上找的,结果还是不行,我又改装了一下
Function strLength(str)
dim l,t,c
dim i
l=len(str)
t=l
for i=1 to l
c=asc(mid(str,i,1))
if c>127 or c<0 then
t=t+2
else
t=t+1
end if
next
strLength=t
End Function
结果还是一样,我晕死

第三个办法:使用动网的方法:
动网截取字符函数：
'截取指定字符
Function cutStr(str,strlen)
'去掉所有HTML标记
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="<(.[^>]*)>"
str=re.Replace(str,"")
set re=Nothing
Dim l,t,c,i
l=Len(str)
t=0
For i=1 to l
c=Abs(Asc(Mid(str,i,1)))
If c>255 Then
t=t+2
Else
t=t+1
End If
If t>=strlen Then
cutStr=left(str,i)&"..."
Exit For
Else
cutStr=str
End If
Next
cutStr=Replace(cutStr,chr(10),"")
cutStr=Replace(cutStr,chr(13),"")
End Function

没想到,结果还是不对,还是老样子,我都快崩溃了

第四个方法:还是网上找的
Function CheckStringLength(txt)
dim x,y
txt=trim(txt)
x = len(txt)
y = 0
for ii = 1 to x
if asc(mid(txt,ii,1))<0 or asc(mid(txt,ii,1))>255 then
y = y + 2
else
y = y + 1
end if
next
CheckStringLength = y
End Function

'"************* 截取字符串 **************
Function InterceptString(txt,length)
dim x,y,k
txt=trim(txt)
x = len(txt)
y = 0
if x >= 1 then
for k = 1 to x
if asc(mid(txt,k,1)) < 0 or asc(mid(txt,k,1)) >255 then
y = y + 2
else
y = y + 1
end if
if y >= length then
txt = left(trim(txt),k) '"字符串限长
exit for
end if
next
InterceptString = txt
else
InterceptString = ""
end if
End Function

哎,还是不对,伤心死了,一个晚上就这么浪费了

再试一个
第五个办法
function strleft(str,l)
dim temp_str,test_str
dim lens,i
temp_str=len(str)
for i=1 to temp_str
test_str=(mid(str,i,1))
strleft=strleft&test_str
if asc(test_str)>0 then
lens=lens+1
else
lens=lens+2
end if
if lens>=l then exit for
next
end function

结果还是让人那么的伤心

第六次了:
function cutStr(strtitle,counts)
dim c,num,e_word
Dim Str 'As String '注释：总字符
Dim k 'As Long '注释：计数器
Dim tmpStr 'As String '注释：逐一检测的字符

c = 0: e_word = 0: Num = 0 '注释：清空变量
Str = strtitle & " " '注释：加一空格便于意外时计算最后一个字符
For k = 1 To Len(Str) - 1
tmpStr = Mid(Str, k, 1)

If Asc(tmpStr) >= 65 And Asc(tmpStr) <= 90 Then '注释：小写字母
If Asc(Mid(Str, k + 1, 1)) <= 64 Then e_word = e_word + 1
If Asc(Mid(Str, k + 1, 1)) > 90 And Asc(Mid(Str, k + 1, 1)) < 97 Then e_word = e_word + 1
If Asc(Mid(Str, k + 1, 1)) > 122 Then e_word = e_word + 1
If Asc(Mid(Str, k + 1, 1)) = 39 Or Asc(Mid(Str, k + 1, 1)) = 45 Then e_word = e_word - 1 '注释：是符号注释：或-时
ElseIf Asc(tmpStr) >= 97 And Asc(tmpStr) <= 122 Then '注释：大写字母
If Asc(Mid(Str, k + 1, 1)) < 65 Then e_word = e_word + 1
If Asc(Mid(Str, k + 1, 1)) > 90 And Asc(Mid(Str, k + 1, 1)) < 97 Then e_word = e_word + 1
If Asc(Mid(Str, k + 1, 1)) > 122 Then e_word = e_word + 1
If Asc(Mid(Str, k + 1, 1)) = 39 Or Asc(Mid(Str, k + 1, 1)) = 45 Then e_word = e_word - 1 '注释：是符号注释：或-时
ElseIf Asc(tmpStr) >= 48 And Asc(tmpStr) <= 57 Then '注释：阿拉伯数字数字
If Asc(Mid(Str, k + 1, 1)) < 48 Or Asc(Mid(Str, k + 1, 1)) > 57 Then Num = Num + 1
ElseIf Asc(tmpStr) > 127 Or Asc(tmpStr) < 0 Then '注释：中文字符
c = c + 1
End If
Next
cutStr=2*c+e_word+Num
end function

结果一样.

在网上还看到另一个获取字数,中文为2,英文为1的方法,不过是VB的方法,按理说ASP就是VB语法,应该是可以用的,可惜我试一下,结果不行,不过还是写上来吧
s = LenB(StrConv(Text1.Text, vbFromUnicode)) 注释：全部字符
s = LenB(StrConv(Text1.Text, vbUnicode)) 注释：全部字符
结果报错vbFromUnicode或者vbUnicode没有定义.

哎,夜深了,我也该睡了,以后有时间再想办法吧

================================================

终于,终于解决了,刚刚找到一个好办法哈哈,已经0点多了,终于找到了一个很好的解决办法,代码如下

function busfly_randomsort_cutTitle(ByVal strtitle,ByVal counts)
Dim RegExpObj,ReGCheck
Set RegExpObj=new RegExp
RegExpObj.Pattern="^[\u4e00-\u9fa5]+$"
Dim l,t,c,i
l=Len(strtitle)
t=0
For i=1 to l
c=Mid(strtitle,i,1)
ReGCheck=RegExpObj.test(c)
If ReGCheck Then
t=t+2
Else
t=t+1
End If
If t>=counts Then
busfly_randomsort_cutTitle=left(strtitle,i)&"..."
Exit For
Else
busfly_randomsort_cutTitle=strtitle
End If
Next
Set RegExpObj=nothing
busfly_randomsort_cutTitle=Replace(busfly_randomsort_cutTitle,chr(10),"")
busfly_randomsort_cutTitle=Replace(busfly_randomsort_cutTitle,chr(13),"")

'busfly_randomsort_cutTitle=cutStr(strtitle,counts)
end function
这个办法里只是将中文计算为2个字数,而中文的标点符号却还是当作1个,这似乎不太好,不过已经好多了,在标题里的标点毕竟是少数.正则表达式就是强大哈

----------------------

哈哈,已经0点多了,终于找到了一个很好的解决办法,代码如下

function busfly_randomsort_cutTitle(ByVal strtitle,ByVal counts)
Dim RegExpObj,ReGCheck
Set RegExpObj=new RegExp
RegExpObj.Pattern="^[\u4e00-\u9fa5]+$"
Dim l,t,c,i
l=Len(strtitle)
t=0
For i=1 to l
c=Mid(strtitle,i,1)
ReGCheck=RegExpObj.test(c)
If ReGCheck Then
t=t+2
Else
t=t+1
End If
If t>=counts Then
busfly_randomsort_cutTitle=left(strtitle,i)&"..."
Exit For
Else
busfly_randomsort_cutTitle=strtitle
End If
Next
Set RegExpObj=nothing
busfly_randomsort_cutTitle=Replace(busfly_randomsort_cutTitle,chr(10),"")
busfly_randomsort_cutTitle=Replace(busfly_randomsort_cutTitle,chr(13),"")
end function