<code id="lymdv"><nobr id="lymdv"></nobr></code>
  1. <tr id="lymdv"></tr>

    <strike id="lymdv"></strike><object id="lymdv"></object><th id="lymdv"><option id="lymdv"></option></th>

    1. ASP 設為首頁 | 加入收藏 | 咨詢熱線:0594-2266222 6666543
      全國民辦教育機構評選,授予“2007年度最受歡迎培訓機構”榮譽稱號
      北京新亞研修學院、前進大學聯合辦學打造技能加學歷全新教學模式
      莆田市勞動局指定農村剩余勞動力、下崗職工再就業定點培訓學校
      ASP 學校首頁  學校簡介  專業設置   學歷教育    校園風景  辦學優勢  學校榮譽  最新動態  就業動態  就業回訪  考試考證  恒心英才
       學生考勤  學子心聲  加盟合作  發票查詢 乘車路線    學校論壇  ~在線報名
      ASP ASP
           您當前的位置:首頁 - 學技文粹 

      ASP 常用的自定義函數

      ASP
      閱讀次數:11953 發表時間: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
      WWW.1109K.COM