(已解决)ZBLOG中ASP的left-mid-right如何区分中文为2个字符英文为1个

ZBLOG中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个,这似乎不太好,不过已经好多了,在标题里的标点毕竟是少数.正则表达式就是强大哈这两天就去更新一下ZBLOG的列表插件(\文章排行).哈哈

Tags: Zblog

原创文章如转载，请注明：转载自：巴士飞扬-技术BLOG : http://www.busfly.cn/

本文链接地址：http://www.busfly.cn/post/ASP-left-mid-right.html

如果你喜欢本文，请顶一下，支持我，你的支持是我继续发好文章的最大动力。谢谢。
好东西需要分享，快把本文发给你的朋友吧~!~