<% '************************************************* '函数名: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," "," "),""",chr(34)),">",">"),"<","<") 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," "," "),chr(34),"""),">",">"),"<","<") 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,"?")1 then if InStr(strUrl,"&")" if ShowTotal=true then strTemp=strTemp & "共 " & totalnumber & " " & strUnit & "  " end if strUrl=JoinChar(sfilename) if CurrentPage<2 then strTemp=strTemp & "首页 上一页 " else strTemp=strTemp & "首页 " strTemp=strTemp & "上一页 " end if if n-currentpage<1 then strTemp=strTemp & "下一页 尾页" else strTemp=strTemp & "下一页 " strTemp=strTemp & "尾页" end if strTemp=strTemp & " 页次:" & CurrentPage & "/" & n & "页 " strTemp=strTemp & " " & maxperpage & "" & strUnit & "/页" if ShowAllPages=True then strTemp=strTemp & " 转到:" end if strTemp=strTemp & "" 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= "
  • 没有安装JMail组件
  • " 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 & "错误信息" & vbcrlf strErr=strErr & "" & vbcrlf strErr=strErr & "" & vbcrlf strErr=strErr & " " & vbcrlf strErr=strErr & " " & vbcrlf strErr=strErr & " " & vbcrlf strErr=strErr & "
    错误信息
    产生错误的可能原因:
    " & errmsg &"
    【返回】
    " & vbcrlf strErr=strErr & "" & vbcrlf response.write strErr end sub '**************************************************** '过程名:WriteSuccessMsg '作 用:显示成功提示信息 '参 数:无 '**************************************************** sub WriteSuccessMsg(SuccessMsg) dim strSuccess strSuccess=strSuccess & "成功信息" & vbcrlf strSuccess=strSuccess & "" & vbcrlf strSuccess=strSuccess & "" & vbcrlf strSuccess=strSuccess & " " & vbcrlf strSuccess=strSuccess & " " & vbcrlf strSuccess=strSuccess & " " & vbcrlf strSuccess=strSuccess & "
    恭喜你!

    " & SuccessMsg &"
    【返回】
    " & vbcrlf strSuccess=strSuccess & "" & 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 sub ShowAnnounce(AnnounceNum) dim sqlAnnounce,rsAnnounce,i if AnnounceNum>0 and AnnounceNum<=10 then sqlAnnounce="select top " & AnnounceNum else sqlAnnounce="select top 10" end if sqlAnnounce=sqlAnnounce & " * from affiche order by ID Desc" Set rsAnnounce= Server.CreateObject("ADODB.Recordset") rsAnnounce.open sqlAnnounce,conn,1,1 if rsAnnounce.bof and rsAnnounce.eof then AnnounceCount=0 response.write "

      没有公告

    " else AnnounceCount=rsAnnounce.recordcount do while not rsAnnounce.eof response.Write "  " &rsAnnounce("title") & "" rsAnnounce.movenext i=i+1 loop end if rsAnnounce.close set rsAnnounce=nothing end sub %>