ASP 设为首页 | 加入收藏 | 咨询热线:0594-2266222 6666543
全国民办教育机构评选,授予“2007年度最受欢迎培训机构”荣誉称号
北京新亚研修学院、前进大学联合办学打造技能加学历全新教学模式
莆田市劳动局指定农村剩余劳动力、下岗职工再就业定点培训学校
ASP 学校首页  学校简介  专业设置   学历教育    校园风景  办学优势  学校荣誉  最新动态  就业动态  就业回访  考试考证  恒心英才
 学生考勤  学子心声  加盟合作  发票查询 乘车路线    学校论坛  ~在线报名
ASP ASP
     您当前的位置:首页 - 学技文粹 

ASP 常用的自定义函数

ASP
阅读次数:11443 发表时间:2010-7-2 

<%
'*************************************************
'函数名: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  ----网址
'返回值:加了 ? 或 & 的网址
'pos=InStr(1,"abcdefg","cd")
'则pos会返回3表示查找到并且位置为第三个字符开始。
'这就是“查找”的实现,而“查找下一个”功能的
'实现就是把当前位置作为起始位置继续查找。
'***********************************************
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 if
end function

'***********************************************
'过程名:showpage
'作  用:显示“上一页 下一页”等信息
'参  数:sfilename  ----链接地址
'       totalnumber ----总数量
'       maxperpage  ----每页数量
'       ShowTotal   ----是否显示总数量
'       ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用,否则会出现JS错误。
'       strUnit     ----计数单位
'***********************************************
sub showpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
 
 dim n, i,strTemp,strUrl
 if totalnumber mod maxperpage=0 then
     n= totalnumber \ maxperpage
   else
     n= totalnumber \ maxperpage+1
   end if
   strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
 if ShowTotal=true then
  strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
 end if
 strUrl=JoinChar(sfilename)
   if CurrentPage<2 then
      strTemp=strTemp & "首页 上一页&nbsp;"
   else
      strTemp=strTemp & "<a href='" & strUrl & "page=1'>首页</a>&nbsp;"
      strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一页</a>&nbsp;"
   end if

   if n-currentpage<1 then
      strTemp=strTemp & "下一页 尾页"
   else
      strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一页</a>&nbsp;"
      strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾页</a>"
   end if
    strTemp=strTemp & "&nbsp;页次:<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
    strTemp=strTemp & "&nbsp;<b>" & maxperpage & "</b>" & strUnit & "/页"
 if ShowAllPages=True then
  strTemp=strTemp & "&nbsp;转到:<select name='page' size='1' onchange='javascript:submit()'>"  
     for i = 1 to n  
      strTemp=strTemp & "<option value='" & i & "'"
   if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
   strTemp=strTemp & ">第" & i & "页</option>"  
     next
  strTemp=strTemp & "</select>"
 end if
 strTemp=strTemp & "</td></tr></form></table>"
 response.write strTemp 
end sub

'***********************************************
'过程名:enshowpage
'作  用:显示“上一页 下一页”等信息
'参  数:sfilename  ----链接地址
'       totalnumber ----总数量
'       maxperpage  ----每页数量
'       ShowTotal   ----是否显示总数量
'       ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用,否则会出现JS错误。
'       strUnit     ----计数单位
'***********************************************
sub enshowpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
 dim n, i,strTemp,strUrl
 if totalnumber mod maxperpage=0 then
     n= totalnumber \ maxperpage
   else
     n= totalnumber \ maxperpage+1
   end if
   strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
 if ShowTotal=true then
  strTemp=strTemp & "Total <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
 end if
 strUrl=JoinChar(sfilename)
   if CurrentPage<2 then
      strTemp=strTemp & "First  Previous&nbsp;"
   else
      strTemp=strTemp & "<a href='" & strUrl & "page=1'>First</a>&nbsp;"
      strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>Previous</a>&nbsp;"
   end if

   if n-currentpage<1 then
      strTemp=strTemp & "Next  Last"
   else
      strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>Next</a>&nbsp;"
      strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>Last</a>"
   end if
    strTemp=strTemp & "&nbsp;Page No.:<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>page "
    strTemp=strTemp & "&nbsp;<b>" & maxperpage & "</b>" & strUnit & "/page"
 if ShowAllPages=True then
  strTemp=strTemp & "&nbsp;Turn to:<select name='page' size='1' onchange='javascript:submit()'>"  
     for i = 1 to n  
      strTemp=strTemp & "<option value='" & i & "'"
   if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
   strTemp=strTemp & ">No." & i & "page</option>"  
     next
  strTemp=strTemp & "</select>"
 end if
 strTemp=strTemp & "</td></tr></form></table>"
 response.write strTemp
end sub

 

'********************************************
'函数名: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 if
end 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 = 0
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

'****************************************************
'函数名: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 if
end function

'****************************************************
'过程名:WriteErrMsg
'作  用:显示错误提示信息
'参  数:无
'****************************************************
sub WriteErrMsg()
 dim strErr
 strErr=strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
 strErr=strErr & "<link href='style.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
 strErr=strErr & "<table cellpadding=2 cellspacing=2 border=0 width=400 class='border' align=center>" & vbcrlf
 strErr=strErr & "  <tr align='center'><td height='20' class='title'><strong>错误信息</strong></td></tr>" & vbcrlf
 strErr=strErr & "  <tr><td height='100' class='tdbg' valign='top'><b>产生错误的可能原因:</b><br>" & errmsg &"</td></tr>" & vbcrlf
 strErr=strErr & "  <tr align='center'><td class='title'><a href='javascript:history.go(-1)'>【返回】</a></td></tr>" & vbcrlf
 strErr=strErr & "</table>" & vbcrlf
 strErr=strErr & "</body></html>" & vbcrlf
 response.write strErr
end sub

'****************************************************
'过程名:WriteSuccessMsg
'作  用:显示成功提示信息
'参  数:无
'****************************************************
sub WriteSuccessMsg(SuccessMsg)
 dim strSuccess
 strSuccess=strSuccess & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
 strSuccess=strSuccess & "<link href='style.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
 strSuccess=strSuccess & "<table cellpadding=2 cellspacing=2 border=0 width=400 class='border' align=center>" & vbcrlf
 strSuccess=strSuccess & "  <tr align='center'><td height='20' class='title'><strong>恭喜你!</strong></td></tr>" & vbcrlf
 strSuccess=strSuccess & "  <tr><td height='100' class='tdbg' valign='top'><br>" & SuccessMsg &"</td></tr>" & vbcrlf
 strSuccess=strSuccess & "  <tr align='center'><td class='title'><a href='javascript:history.go(-1)'>【返回】</a></td></tr>" & vbcrlf
 strSuccess=strSuccess & "</table>" & vbcrlf
 strSuccess=strSuccess & "</body></html>" & vbcrlf
 response.write strSuccess
end sub

function getFileExtName(fileName)
    dim pos
    pos=instrrev(filename,".")
    if pos>0 then
        getFileExtName=mid(fileName,pos+1)
    else
        getFileExtName=""
    end if
end function
%>

 
下页: 决定成功的10种积极心 上页: ASP经验大全 ASP经验大全
 
ASP经验大全
   

校区一:莆田市城厢区万达广场6号门对面三楼

电话:0594-2266222
校区二:莆田城厢区万达广场旁福利区后门旁(原私立中学) 电话:0594-6666543
莆田市恒心电脑职业培训学校版权所有 闽ICP备11008856号-1
关闭
05946666543 工作日:8:00-23:00
周 六:8:00-23:00