首页 | 心情日记 | 建站心得 | 编程技术 | 大盘分析 | 股市信息 | 学习园地 | 电脑技巧 | 物流外贸 | 另类其它 | 站长推荐 | 给我留言 | 相册

用户登陆
用户:
密码:
 
不保存保存一天
保存一月保存一年

站点日历
73 2024 - 4 48
 123456
78910111213
14151617181920
21222324252627
282930


站点统计

最新评论

日志搜索

 标题   内容


ASP获取字符串长度的自定义函数 ASP判断字符串长度(考虑汉字问题)
未知 实用asp函数 字符串长度、分页等   [ 日期:2010-01-23 14:31:25 ]   [ 来自:本站原创 ]

海外邮件中继,海外退信中继,美国高速VPS,不限流量VPN,邮局维护和管理,邮件网关,EMOS邮件中继,POSTFIX邮件中继,Winwebmail邮件中继,Winmail邮件中继,DBMail邮件中继,JDMail邮件中继,Exchange邮件中继,MDaemon邮件中继 淘宝店:http://shantan.taobao.com 云邮科技官网:www.yunrelay.com

【字体设置:
<% 
'**************************************************
'函数名:rndNum
'作   用:求随机长度数字
'参   数:strLong长度,
'返回值:字符串
'**************************************************
Function rndNum (strLong) 
Dim temNum 
   Randomize
   Do While Len(RndNum) < strLong 
    temNum=CStr(Chr((57-48)*rnd+48)) 
    RndNum=RndNum&temNum
   loop 
End Function

'**************************************************
'函数名:newleft
'作   用:取前字符串。l要求长度的
'参   数:str字符串,
'返回值:字符串
'**************************************************
Function newleft(str,l)
if len(str)>l then
   newleft=left(str,l)&"…"
else
   newleft=str
end if
End Function

'**************************************************
'函数名:strLength
'作   用:求字符串长度。汉字算两个字符,英文算一个字符。
'参   数:str   ----要求长度的字符串
'返回值:字符串长度
'**************************************************
function strLength(str)
ON ERROR RESUME NEXT
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
             if c>255 then
                 t=t+1
             end if
         next
         strLength=t
     else 
         strLength=len(str)
     end if
     if err.number<>0 then err.clear
end function
''''''''''''''''''中英文长度获取和截取
   Function    CountLength(Str)   
   Dim    output,ThisChar,i   
   output    =    0   
   For    i    =    1    To    Len(Str)   
   ThisChar    =    Mid(Str,i,1)   
   If    Asc(ThisChar)    <    0    Then   
   output    =    output    +    2   
   Else   
   output    =    output    +    1   
   End    If   
   Next   
   CountLength    =    output   
   End    Function   
    
   Function    MaxLengthStr(ByVal    Str,    ByVal    MaxLength)   
   Dim    Output,i   
   If    IsNull(Str)    Then    Str    =    ""   
   Output    =    ""   
   If    LenB(Str)    <=    MaxLength    Then   
   Output    =    Str   
   Else   
   For    i    =    1    To    Len(Str)   
   Output    =    Output    &    Mid(Str,i,1)   
   If    CountLength(Output)+3    =    MaxLength    Then   
   Output    =    Output      
   Exit    For   
   ElseIf    CountLength(Output)+3    >    MaxLength    Then   
   Output    =    Left(Output,Len(Output)-1)     
   Exit    For   
   End    If   
   Next   
   End    If   
   MaxLengthStr    =    Output   
   End    Function   
'过滤HTML代码
function HTMLEncode(fString)
dim tempstr
tempstr=fString
if not isnull(tempstr) then
   tempstr = replace(tempstr, ">", "&gt;")
   tempstr = replace(tempstr, "<", "&lt;")
   tempstr = Replace(tempstr, CHR(32), "&nbsp;")
   tempstr = Replace(tempstr, CHR(9), "&nbsp;")
   tempstr = Replace(tempstr, CHR(34), "&quot;")
   tempstr = Replace(tempstr, CHR(39), "&#39;")
   tempstr = Replace(tempstr, CHR(13), "")
   tempstr = Replace(tempstr, CHR(10) & CHR(10), "</P><P> ")
   tempstr = Replace(tempstr, CHR(10), "<BR> ")
   HTMLEncode = tempstr
end if
end function
'反过滤HTML代码
function UNHTMLEncode(fString)
dim tempstr
tempstr=fString
if not isnull(tempstr) then
   tempstr = replace(tempstr, "&gt;", ">")
   tempstr = replace(tempstr, "&lt;", "<")
   tempstr = Replace(tempstr, "&nbsp;", CHR(32))
   tempstr = Replace(tempstr, "&nbsp;", CHR(9))
   tempstr = Replace(tempstr, "&quot;", CHR(34))
   tempstr = Replace(tempstr, "&#39;", CHR(39))
   tempstr = Replace(tempstr, "", CHR(13))
   tempstr = Replace(tempstr, "</P><P> ", CHR(10) & CHR(10))
   tempstr = Replace(tempstr, "<BR> ", CHR(10))
   UNHTMLEncode = tempstr
end if
end function

'去除HTML标记
Function FilterHTML(Str)

Dim StrContent
StrContent = Trim(Str)
StrContent = Replace(StrContent,"width>screen.","")
StrContent = Replace(StrContent,"&nbsp;","")
StrContent = Replace(StrContent,Chr(13)&Chr(10),"")
If Len(StrContent)>5 Then
   Dim objRegExp, strOutput
   Set objRegExp = New Regexp

   objRegExp.IgnoreCase = True
   objRegExp.Global = True
   objRegExp.Pattern = "<.+?>"

   'Replace all HTML tag matches with the empty string
   StrContent = objRegExp.Replace(StrContent,"")
End If
StrContent = Replace(StrContent," ","")
FilterHTML=Left(StrContent,200)
End Function

'*************************************************
'函数名:gotTopic
'作   用:截字符串,汉字一个算两个字符,英文算一个字符
'参   数:str    ----原字符串
'        strlen ----截取长度
'返回值:截取后的字符串
'*************************************************
function gotTopic(str,strlen)
if str="" then
   gotTopic=""
   exit function
end if
dim l,t,c, i
str=replace(replace(replace(replace(str,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
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 exit for
next
if i < l then
   gotTopic=left(str,i) & "…"
else
   gotTopic=str
end if
'gotTopic=replace(replace(replace(replace(gotTopic," ","&nbsp;"),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
end function


'***********************************************
'函数名:JoinChar
'作   用:向地址中加入 ? 或 &
'参   数:strUrl   ----网址
'返回值:加了 ? 或 & 的网址
'***********************************************
function JoinChar(strUrl)
if strUrl="" then
   JoinChar=""
   exit function
end if

if InStr(strUrl,"?")>0 then
   JoinChar=strUrl & "&"
else
   JoinChar=strUrl & "?"
end if

end function

'***********************************************
'函数名:showpages
'作   用:显示“上一页 下一页”等信息
'参   数: sfilename ----链接地址
'         totalnumber ----总数量
'    totalpage ----总页数
'    maxperpage ----每页数量
'    page ----当前页
'    ShowTotal ----是否显示总数量
'    ShowForm ----是否显示跳转表单
'    strUnit      ----计数单位
'***********************************************

Function showpages(sfilename,totalnumber,totalpage,maxperpage,page,ShowTotal,ShowForm,strUnit)
dim i,strTemp,strUrl
    strTemp= "<table width=""98%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"">"&vbcrlf
strTemp=strTemp & "<form name='Form2' method='Post' action='" & sfilename & "'>"&vbcrlf
strTemp=strTemp & "<tr>"&vbcrlf
strTemp=strTemp & "<td align='right'>"&vbcrlf
if ShowTotal=true then 
   strTemp=strTemp & "共有<b> "& totalnumber &" </b>"& strUnit &"&nbsp; "
   strTemp=strTemp & "<b> "&maxperpage&" </b> "& strUnit &"/页&nbsp; "
end if
strUrl=JoinChar(sfilename)
page=int(page)
totalpage=int(totalpage)
    if page<2 then
       strTemp=strTemp & "&nbsp;首页 &nbsp;前一页&nbsp;"
    else
    strTemp=strTemp & "&nbsp;<a href='" & strUrl & "page=1'>首页</a>&nbsp; "
    strTemp=strTemp & "<a href='" & strUrl & "page=" & page-1 & "'>前一页</a>&nbsp;"
    end if

    if totalpage-page<1 then
       strTemp=strTemp & "下一页&nbsp;尾页"
    else
    strTemp=strTemp & "<a href='" & strUrl & "page=" & page+1 & "'>下一页</a>&nbsp;"
    strTemp=strTemp & "<a href='" & strUrl & "page=" & totalpage & "'>尾页</a>&nbsp;"
    end if
if ShowTotal=true then 
   strTemp=strTemp & "&nbsp;当前:<b><font color=red>"& page &"</font>"
   strTemp=strTemp & "/"& totalpage &"</b>页"
end if
if ShowForm=True then
   strTemp=strTemp & "&nbsp;转到:<select name=""page"" "
   strTemp=strTemp & "size=""1"" onChange=""javascript:submit()"">" &vbcrlf 
      for i = 1 to totalpage
       strTemp=strTemp & "<option value='" & i & "'"
    if page=i then strTemp=strTemp & " selected "
    strTemp=strTemp & ">第" & i & "页</option>"&vbcrlf  
      next
   strTemp=strTemp & "</select>"&vbcrlf
end if
strTemp=strTemp & "</td>"&vbcrlf
strTemp=strTemp & "</tr>"&vbcrlf
strTemp=strTemp & "</form>"&vbcrlf
strTemp=strTemp & "</table>"&vbcrlf
showpages = strTemp

End Function

'***********************************************
'函数名:showpages2
'作   用:显示“上页 1 | 2 | 3 下页”等信息
'参   数: sfilename ----链接地址
'         totalnumber ----总数量
'    totalpage ----总页数
'    maxperpage ----每页数量
'    page ----当前页
'    ShowForm ----是否显示跳转表单
'***********************************************

Function showpages2(sfilename,totalnumber,totalpage,maxperpage,page,ShowForm)
dim i,strTemp,strUrl
    strTemp= "<table width=""98%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"">"&vbcrlf
strTemp=strTemp & "<form name='Form2' method='Post' action='" & sfilename & "'>"&vbcrlf
strTemp=strTemp & "<tr>"&vbcrlf
strTemp=strTemp & "<td align='right'>"&vbcrlf

strUrl=JoinChar(sfilename)
page=int(page)
totalpage=int(totalpage)
    if page>1 then
    strTemp=strTemp & "&nbsp;<a href='" & strUrl & "page=1'>首页</a>&nbsp; "
    strTemp=strTemp & "<a href='" & strUrl & "page=" & page-1 & "'>上页</a>&nbsp;"
    end if

if totalpage<10 then
   bno=1:eno=totalpage
elseif page < 5 then
   bno=1:eno=10
elseif totalpage - page < 5 then
   bno=totalpage-9:eno=totalpage
else
   bno=page-4:eno=page+5
end if

for i = bno to eno
   if i = bno then
    strTemp=strTemp & "&nbsp;&nbsp;"
   else
    strTemp=strTemp & "&nbsp;&nbsp;|&nbsp;&nbsp;"
   end if
   if i = page then
    strTemp=strTemp & "<span style='color:red'>"
    strTemp=strTemp & i
    strTemp=strTemp & "</span>"
   else
    strTemp=strTemp & "<a href='" & strUrl & "page="&i&"'>"
    strTemp=strTemp & i
    strTemp=strTemp & "</a>"
   end if
next
strTemp=strTemp & "&nbsp;&nbsp;"

    if totalpage-page>0 then
    strTemp=strTemp & "<a href='" & strUrl & "page=" & page+1 & "'>下页</a>&nbsp;"
    strTemp=strTemp & "<a href='" & strUrl & "page=" & totalpage & "'>尾页</a>&nbsp;"
    end if
if ShowForm=True then
   strTemp=strTemp & "&nbsp;转到:"
   strTemp=strTemp & "<input type=""text"" name=""page"" id=""page"" value="""&page&""" style=""width:30px;"">"
   strTemp=strTemp & "<input type=""submit"" name=""gopage"" value=""GO"" style=""width:24px;"">"
end if
strTemp=strTemp & "</td>"&vbcrlf
strTemp=strTemp & "</tr>"&vbcrlf
strTemp=strTemp & "</form>"&vbcrlf
strTemp=strTemp & "</table>"&vbcrlf
showpages2 = strTemp

End Function


'***********************************************
'函数名:showHTMLpages
'作   用:显示“上页 1 | 2 | 3 下页”等信息
'参   数: sfilename ----链接地址
'         totalnumber ----总数量
'    totalpage ----总页数
'    maxperpage ----每页数量
'    page ----当前页
'    ShowForm ----是否显示跳转表单
'***********************************************

Function showHTMLpages(sfilename,totalnumber,totalpage,maxperpage,page,ShowForm)
dim i,strTemp,strUrl
    strTemp= "<table width=""98%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"">"&vbcrlf
strTemp=strTemp & "<tr>"&vbcrlf
strTemp=strTemp & "<td align='right'>"&vbcrlf

page=int(page)
totalpage=int(totalpage)
    if page>1 then
    strTemp=strTemp & "&nbsp;<a href='" & sfilename & "1.htm'>首页</a>&nbsp; "
    strTemp=strTemp & "<a href='" & sfilename & (page-1) & ".htm'>上页</a>&nbsp;"
    end if

if totalpage<10 then
   bno=1:eno=totalpage
elseif page < 5 then
   bno=1:eno=10
elseif totalpage - page < 5 then
   bno=totalpage-9:eno=totalpage
else
   bno=page-4:eno=page+5
end if

for i = bno to eno
   if i = bno then
    strTemp=strTemp & "&nbsp;&nbsp;"
   else
    strTemp=strTemp & "&nbsp;&nbsp;|&nbsp;&nbsp;"
   end if
   if i = page then
    strTemp=strTemp & "<span style='color:red'>"
    strTemp=strTemp & i
    strTemp=strTemp & "</span>"
   else
    strTemp=strTemp & "<a href='" & sfilename & i & ".htm'>"
    strTemp=strTemp & i
    strTemp=strTemp & "</a>"
   end if
next
strTemp=strTemp & "&nbsp;&nbsp;"

    if totalpage-page>0 then
    strTemp=strTemp & "<a href='" & sfilename & (page+1) & ".htm'>下页</a>&nbsp;"
    strTemp=strTemp & "<a href='" & sfilename & totalpage & ".htm'>尾页</a>&nbsp;"
    end if
if ShowForm=True then
   strTemp=strTemp & "&nbsp;转到:"
   strTemp=strTemp & "<input type=""text"" name=""page"" id=""page"" value="""&page&""" style=""width:30px;"" />"
   strTemp=strTemp & "<input type=""button"" name=""gopage"" value=""GO"" style=""width:24px;"" onClick=""javascript:location.href='" & sfilename & "' + document.getElementById('page').value + '.htm';"" />"
end if
strTemp=strTemp & "</td>"&vbcrlf
strTemp=strTemp & "</tr>"&vbcrlf
strTemp=strTemp & "</table>"&vbcrlf
showHTMLpages = strTemp

End Function


function rootidtoname(rootid,tabname)

dim mrootid,mrootname
if tabname="" then tabname="msg_class"
mrootid=rootid
if mrootid<>"" then
root=split(mrootid,",")
mrootname=""
for i = 0 to ubound(root)
   sql="select id,title from "&tabname&" where id="&int(root(i))
   rs2.open sql,conn,1,1
   if not rs2.eof then
    if i > 0 then
     mrootname=mrootname&" &gt;&gt; "
    end if
    mrootname=mrootname&rs2("title")
   end if
   rs2.close
next
rootidtoname=mrootname
else
rootidtoname=""
end if

end function


Function clngstr(str,lng) 
dim strtemp
strtemp=Right("000000000"&str,lng)
clngstr=strtemp
end function


'删除数组内的元素

function delarray(astr,ano)
'on error resume next
dim atemp,ai
atemp=astr
aa=int(ano)

if isarray(atemp) then
   ai=ubound(atemp)
   if aa > ai then
    delarray=atemp
    exit function
   elseif ai=0 then
    delarray=""
    exit function
   elseif aa=ai then
    ReDim Preserve atemp(ai-1)
   else
    for i = aa to ai - 1
      atemp(i)=atemp(i+1)
    next
    ReDim Preserve atemp(ai-1)
   end if
else
   delarray=atemp
   exit function
end if

delarray=atemp

end function


'删除文件
function delfile(filename)
on error resume next
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
if objFSO.fileExists(Server.MapPath(filename)) then
   objFSO.DeleteFile(Server.MapPath(filename))
   delfile=true
else
   delfile=false
   exit function
end if
set objFSO=nothing
delfile=true
end function

'转长日期格式
function clngdate(tdate)
tempdate=cstr(tdate)
if tempdate="" then
   clngdate=""
   exit function
end if
td=split(tempdate,"-")
if ubound(td)<>2 then 
   clngdate=tempdate
   exit function
end if
if len(td(1))=1 then td(1)="0"&td(1)
if len(td(2))=1 then td(2)="0"&td(2)
clngdate=td(0)&"-"&td(1)&"-"&td(2)
end function

%>


暂时没有评论
   发表评论 - 不要忘了输入验证码哦!
作者: 用户:  密码:  我要注册 验证码: 
为防止广告注册机程序,验证码不会自动显示,请点击此处显示或者(刷新)验证码!
评论:

禁止表情
禁止UBB
禁止图片
识别链接
识别关键字
确定发布?
最多可以输入200个字,目前你已经输入了0个字;你今日还可以发表10条评论!
 
   

CopyRight © 2008-2010 广东金融学院030904班 All Rights Reserved
Powered by www.030904.com