一些常用的Asp函数

<%'*************************************************'函数名：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   gotTopic=left(str,i) & "…"   exit for  else   gotTopic=str  end if next 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,"?")<len(strUrl) then   if InStr(strUrl,"?")>1 then   if InStr(strUrl,"&")<len(strUrl) then     JoinChar=strUrl & "&"   else    JoinChar=strUrl   end if  else   JoinChar=strUrl & "?"  end if else  JoinChar=strUrl end ifend function

'********************************************'函数名：IsValidEmail'作  用：检查Email地址合法性'参  数：email ----要检查的Email地址'返回值：True  ----Email地址合法'       False ----Email地址不合法'********************************************function IsValidEmail(email) dim names, name, i, c IsValidEmail = true names = Split(email, "@") if UBound(names) <> 1 then    IsValidEmail = false    exit function end if for each name in names  if Len(name) <= 0 then   IsValidEmail = false      exit function  end if  for i = 1 to Len(name)      c = Lcase(Mid(name, i, 1))   if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then         IsValidEmail = false         exit function       end if    next    if Left(name, 1) = "." or Right(name, 1) = "." then       IsValidEmail = false       exit function    end if next if InStr(names(1), ".") <= 0 then  IsValidEmail = false    exit function end if i = Len(names(1)) - InStrRev(names(1), ".") if i <> 2 and i <> 3 then    IsValidEmail = false    exit function end if if InStr(email, "..") > 0 then    IsValidEmail = false end ifend function  

''***************************************************'函数名：IsObjInstalled'作  用：检查组件是否已经安装'参  数：strClassString ----组件名'返回值：True  ----已经安装'       False ----没有安装'***************************************************Function IsObjInstalled(strClassString) On Error Resume Next IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.CreateObject(strClassString) If 0 = Err Then IsObjInstalled = True Set xTestObj = Nothing Err = 0End Function

'***************************************************'函数名：cutstr'作  用：截取标题'参  数：tempstr ----字符串'         tempwid-----字数'***************************************************

function cutstr(tempstr,tempwid)if len(tempstr)>tempwid thencutstr=left(tempstr,tempwid)&"..."elsecutstr=tempstrend ifend 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.clearend function

'****************************************************'函数名：SendMail'作  用：用Jmail组件发送邮件'参  数：ServerAddress  ----服务器地址'        AddRecipient  ----收信人地址'        Subject       ----主题'        Body          ----信件内容'        Sender        ----发信人地址'****************************************************function SendMail(MailServerAddress,AddRecipient,Subject,Body,Sender,MailFrom) on error resume next Dim JMail Set JMail=Server.CreateObject("JMail.SMTPMail") if err then  SendMail= "<br><li>没有安装JMail组件</li>"  err.clear  exit function end if JMail.Logging=True JMail.Charset="gb2312" JMail.ContentType = "text/html" JMail.ServerAddress=MailServerAddress JMail.AddRecipient=AddRecipient JMail.Subject=Subject JMail.Body=MailBody JMail.Sender=Sender JMail.From = MailFrom JMail.Priority=1 JMail.Execute  Set JMail=nothing  if err then   SendMail=err.description  err.clear else  SendMail="OK" end ifend function

'****************************************************'函数名：cutstr'作  用：截取相同字数的字符串'参  数：tempstr  ----字符串'        tempwid  ----个数'****************************************************

function cutstr(tempstr,tempwid)if len(tempstr)>tempwid thencutstr=left(tempstr,tempwid)&"..."elsecutstr=tempstrend ifend function

'****************************************************'函数名：rowscode'作  用：换行'参  数：tempstr  ----字符串'        tempwid  ----个数'****************************************************

Function rowscode(str,n) If len(str)<=n/2 Then rowscode=str Else Dim TStr Dim l,t,c Dim i l=len(str) TStr="" t=0 for i=1 to l c=asc(mid(str,i,1)) If c<0 then c=c+65536 If c>255 then t=t+2 Else t=t+1 End If TStr=TStr&(mid(str,i,1)) If t>n Then TStr=TStr&"<br>" t=0 End if next rowscode= TStr End If End Function  Function LeftTrue(str,n) If len(str)<=n/2 Then LeftTrue=str Else Dim TStr Dim l,t,c Dim i l=len(str) TStr="" t=0 for i=1 to l c=asc(mid(str,i,1)) If c<0 then c=c+65536 If c>255 then t=t+2 Else t=t+1 End If If t>n Then exit for TStr=TStr&(mid(str,i,1)) next LeftTrue = TStr & "…" End If End Function

'过滤地址栏中的参数Public FUNCTION IsInt(Str)    Dim L,I IsInt=FALSE    IF Trim(Str)="" Or IsNull(Str) THEN EXIT FUNCTION Str=CStr(Trim(Str))    L=Len(Str)    FOR I=1 TO L        IF Mid(Str,I,1)>"9" Or Mid(Str,I,1)<"0" THEN EXIT FUNCTION    Next    IsInt=TRUEEND FUNCTION%>