<% '截取非HTML代码的字符 function nohtml(str) dim re Set re=new RegExp re.IgnoreCase =true re.Global=True re.Pattern="(\<.[^\<]*\>)" str=re.replace(str," ") re.Pattern="(\<\/[^\<]*\>)" str=replace(str," ","") str=replace(str,"　","") str=replace(str," ","") str=replace(str,chr(13),"") nohtml=str set re=nothing end function function cutstr(str,strlen,more,url) if len(str)>strlen then str=left(str,strlen) & "......" end if if (len(str)>strlen) and more then str=str+" [url="+url+"]点这里查看详情[/url]" end if cutstr=str end function 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 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 function AutoUrl(str) on error resume next Set url=new RegExp url.IgnoreCase =True url.Global=True url.MultiLine = True url.Pattern = "(^|[^==""])((http|https|ftp|rtsp|mms|pnm|mmst):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)" str = url.Replace(str,"$1

$2") url.Pattern = "([^(http://|http:\\)|^<>\@])((www|cn)[.](\w)+[.]{1,}(net|com|cn|org|cc)(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=](\w)+)*[^<>""]+)*)" str = url.Replace(str,"$1

$2") set url=Nothing AutoUrl=str end function function isInteger(para) on error resume next dim str dim l,i if isNUll(para) then isInteger=false exit function end if str=cstr(para) if trim(str)="" then isInteger=false exit function end if l=len(str) for i=1 to l if mid(str,i,1)>"9" or mid(str,i,1)<"0" then isInteger=false exit function end if next isInteger=true if err.number<>0 then err.clear end function Function MultiPage(Numbers,Perpage,Curpage,Url_Add)'总记录数,每页记录条数,,,URL地址 CurPage=Int(Curpage) Dim URL URL=Request.ServerVariables("Script_Name")&Url_Add MultiPage="" Dim Page,Offset,PageI If Int(Numbers)>Int(PerPage) Then Page=10 Offset=2 Dim Pages,FromPage,ToPage If Numbers Mod Cint(Perpage)=0 Then '计算出共有多少页数 Pages=Int(Numbers/Perpage) Else Pages=Int(Numbers/Perpage)+1 End If FromPage=Curpage-Offset ToPage=Curpage+Page-Offset-1 If Page>Pages Then FromPage=1 ToPage=Pages Else If FromPage<1 Then Topage=Curpage+1-FromPage FromPage=1 If (ToPage-FromPage)Pages Then FromPage =Curpage-Pages +ToPage ToPage=Pages If (ToPage-FromPage)" MultiPage=MultiPage&""&CurPage&"/"&Pages&"" If Curpage>4 Then MultiPage=MultiPage&"1" End If If CurPage=1 Then MultiPage=MultiPage&"1" ElseIf CurPage<4 Then MultiPage=MultiPage&"1" End If If ToPage-CurPage<3 then If ToPage>7 then StPage=ToPage-4 EnPage=ToPage-1 Else StPage=2 EnPage=ToPage-1 End If Else If CurPage<4 then If ToPage>7 then StPage=2 EnPage=5 Else StPage=2 EnPage=ToPage-1 End If Else StPage=CurPage-2 EnPage=CurPage+2 End If End If If CurPage>4 and ToPage>7 then MultiPage=MultiPage&" ... " ElseIF CurPage=4 or (ToPage<6 and CurPage>3) then MultiPage=MultiPage&"1" End If For PageI=StPage TO EnPage If PageI<>CurPage Then MultiPage=MultiPage&""&PageI&"" Else MultiPage=MultiPage&""&PageI&"" End If Next If ToPage-CurPage>3 and ToPage>7 Then MultiPage=MultiPage&" ... " ElseIF CurPage=ToPage-3 or (ToPage<6 and CurPage"&Pages&"" End If If CurPage=ToPage Then MultiPage=MultiPage&""&Pages&"" ElseIf CurPage>Pages-3 Then MultiPage=MultiPage&""&Pages&"" End If If Curpage"&Pages&"" End If MultiPage=MultiPage& " " & vbCrlf MultiPage=MultiPage& " GO " MultiPage=MultiPage&" " Else MultiPage="

1/11" MultiPage=MultiPage& " " MultiPage=MultiPage& " GO

" End If End Function Function HtmlPage(Numbers,Perpage,Curpage,Url_Add) CurPage=Int(Curpage) Dim URL URL=Url_Add HtmlPage="" Dim Page,Offset,PageI If Int(Numbers)>Int(PerPage) Then Page=10 Offset=2 Dim Pages,FromPage,ToPage If Numbers Mod Cint(Perpage)=0 Then Pages=Int(Numbers/Perpage) Else Pages=Int(Numbers/Perpage)+1 End If FromPage=Curpage-Offset ToPage=Curpage+Page-Offset-1 If Page>Pages Then FromPage=1 ToPage=Pages Else If FromPage<1 Then Topage=Curpage+1-FromPage FromPage=1 If (ToPage-FromPage)Pages Then FromPage =Curpage-Pages +ToPage ToPage=Pages If (ToPage-FromPage)" HtmlPage=HtmlPage&""&CurPage&"/"&Pages&"" If Curpage>4 Then HtmlPage=HtmlPage&"1" End If If CurPage=1 Then HtmlPage=HtmlPage&"1" ElseIf CurPage<4 Then HtmlPage=HtmlPage&"1" End If If ToPage-CurPage<3 then If ToPage>7 then StPage=ToPage-4 EnPage=ToPage-1 Else StPage=2 EnPage=ToPage-1 End If Else If CurPage<4 then If ToPage>7 then StPage=2 EnPage=5 Else StPage=2 EnPage=ToPage-1 End If Else StPage=CurPage-2 EnPage=CurPage+2 End If End If If CurPage>4 and ToPage>7 then HtmlPage=HtmlPage&" ... " ElseIF CurPage=4 or (ToPage<6 and CurPage>3) then HtmlPage=HtmlPage&"1" End If For PageI=StPage TO EnPage If PageI<>CurPage Then HtmlPage=HtmlPage&""&PageI&"" Else HtmlPage=HtmlPage&""&PageI&"" End If Next If ToPage-CurPage>3 and ToPage>7 Then HtmlPage=HtmlPage&" ... " ElseIF CurPage=ToPage-3 or (ToPage<6 and CurPage"&Pages&"" End If If CurPage=ToPage Then HtmlPage=HtmlPage&""&Pages&"" ElseIf CurPage>Pages-3 Then HtmlPage=HtmlPage&""&Pages&"" End If If Curpage"&Pages&"" End If HtmlPage=HtmlPage& " " & vbCrlf HtmlPage=HtmlPage& " GO " HtmlPage=HtmlPage&" " Else HtmlPage="

1/11" HtmlPage=HtmlPage& " " HtmlPage=HtmlPage& " GO

" End If End Function Function Password_GenPass( nNoChars, sValidChars ) ' nNoChars = 密码的长度 ' sValidChars = 有效的字符.如果是空则( "" ) ' 默认为: A-Z 和 a-z 和 0-9 '使用方法NewPassword=Password_GenPass(6,"") Const szDefault = "0123456789abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ" Dim nCount Dim sRet Dim nNumber Dim nLength Randomize 'init random If sValidChars = "" Then sValidChars = szDefault End If nLength = Len( sValidChars ) For nCount = 1 To nNoChars nNumber = Int((nLength * Rnd) + 1) sRet = sRet & Mid( sValidChars, nNumber, 1 ) Next Password_GenPass = sRet End Function Function Hx66_AD(AD_ID) '============================================================广告调用 set ADRS=server.createobject("adodb.recordset") sql="select top 1 AD_ID,AD_Title,AD_Http,AD_width,blank,AD_height,AD_Pic,AD_Note,AD_flash,AD_on,AD_Alt from Advertise where AD_on=0 and AD_ID="&AD_ID&"" ADRS.open sql,conn,1,1 If ADRS.bof Then Response.write"" Else if ADRS("AD_flash")=true then Response.Write("

") else if ADRS("AD_http")="" then Response.Write("

") Response.Write(" &ADRS(

") else if ADRS("blank")=true then Response.Write("

") Response.Write(" &ADRS(

") else Response.Write("

") Response.Write(" &ADRS(

") end if end if End If End If end Function Function FormatStr(String) on Error resume next String = Replace(String, CHR(13), "") String = Replace(String, CHR(32), " ") String = Replace(String, " ", " ") String = Replace(String, "<", "<") String = Replace(String, ">", ">") String = Replace(String, CHR(10) & CHR(10), "

") String = Replace(String, CHR(10), "
") FormatStr = String End Function Function CODEStr(String) on Error resume next String = Replace(String, "&", "&") String = Replace(String, "R", "R") String = Replace(String, "r", "r") String = Replace(String, "&", "&") String = Replace(String, """, """) String = Replace(String, "<", "<") String = Replace(String, ">", ">") String = Replace(String, " ", " ") String = Replace(String, "<", "<") String = Replace(String, ">", ">") CODEStr = String End Function Function Jencode(byVal iStr) if isnull(iStr) or isEmpty(iStr) then Jencode="" Exit function end if dim F,i,E F=array("ゴ","ガ","ギ","グ","ゲ","ザ","ジ","ズ","ヅ","デ","ド","ポ","ベ","プ","ビ","パ","ヴ","ボ","ペ","ブ","ピ","バ","ヂ","ダ","ゾ","ゼ") E=array("Jn0;","Jn1;","Jn2;","Jn3;","Jn4;","Jn5;","Jn6;","Jn7;","Jn8;","Jn9;","Jn10;","Jn11;","Jn12;","Jn13;","Jn14;","Jn15;","Jn16;","Jn17;","Jn18;","Jn19;","Jn20;","Jn21;","Jn22;","Jn23;","Jn24;","Jn25;") F=array(chr(-23116),chr(-23124),chr(-23122),chr(-23120),_ chr(-23118),chr(-23114),chr(-23112),chr(-23110),_ chr(-23099),chr(-23097),chr(-23095),chr(-23075),_ chr(-23079),chr(-23081),chr(-23085),chr(-23087),_ chr(-23052),chr(-23076),chr(-23078),chr(-23082),_ chr(-23084),chr(-23088),chr(-23102),chr(-23104),_ chr(-23106),chr(-23108)) Jencode=iStr for i=0 to 25 Jencode=replace(Jencode,F(i),E(i)) next End Function '======================================= 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 function JoinChar(strUrl) if strUrl="" then JoinChar="" exit function end if if InStr(strUrl,"?")1 then if InStr(strUrl,"&") 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 function HTMLEncode(fString) if not isnull(fString) then fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") fString = Replace(fString, CHR(32), " ") fString = Replace(fString, CHR(9), " ") fString = Replace(fString, CHR(34), """) fString = Replace(fString, CHR(39), "'") fString = Replace(fString, CHR(13), "") fString = Replace(fString, CHR(10) & CHR(10), "

") fString = Replace(fString, CHR(10), "
") HTMLEncode = fString end if end function function checknum(str) if isnull(str) or str="" then exit function else if not isnumeric(str) then response.write"

非法操作导致程序中止!" response.end else checknum=int(str) end if end if end function function code_admin(strers,at,acut) dim strer strer=trim(strers) select case int(at) case 1 strer=trim(request.form(strer)) case 2 strer=trim(request.querystring(strer)) end select if isnull(strer) or strer="" then code_admin="" exit function end if 'strer=replace(strer,"'","''") if int(acut)>0 then strer=left(strer,acut) code_admin=strer end function Function post_chk() Dim server_v1,server_v2 post_chk=False server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) If Mid(server_v1,8,len(server_v2))=server_v2 Then post_chk=True End Function function debadstr(str) dim badstr,i debadstr=str badstr=split(hx_In,"|") for i=0 to ubound(badstr) debadstr=replace(debadstr,badstr(i),"***") next end function function chk() chk=false if trim(request.form("chk"))="yes" then chk=post_chk() end if if session("Hx_cms")=false then chk=false end function Function CheckStr(byVal ChkStr) Dim Str:Str=ChkStr Str=Trim(Str) If IsNull(Str) Then CheckStr = "" Exit Function End If Str = Replace(Str,"'","''") Str = replace(Str,"&","&") Str = replace(Str,chr(34),""") Str = Replace(Str, ">", ">") Str = Replace(Str, "<", "<") CheckStr=Str End Function Function checkspace(Str) If Isnull(Str) Then Safereplace = "" Exit Function End If Str = Replace(Str,"execute","[execute]") Str = Replace(Str,"request","[request]") Str = Replace(Str,"'","''") Str = Replace(Str,"--","－－") Str = Replace(Str,";","；") Str = Replace(Str,",","，") Str = Replace(Str,"[","{") Str = Replace(Str,"(","（") Str = Replace(Str,")","）") Str = Replace(Str,"0x","Ox") Str = Replace(Str,"%","％") Str = Replace(Str,"<","＜") Str = Replace(Str,">","＞") Str = Replace(Str,"。","") Str = Replace(Str,"！","") Str = Replace(Str,"!","") checkspace = Str End Function function checkname(str) checkname=true if Instr(str,"=")>0 or Instr(str,"%")>0 or Instr(str,chr(32))>0 or Instr(str,"?")>0 or Instr(str,"&")>0 or Instr(str,";")>0 or Instr(str,",")>0 or Instr(str,"'")>0 or Instr(str,".")>0 or Instr(str,chr(34))>0 or Instr(str,chr(9))>0 or Instr(str,"")>0 or Instr(str,"$")>0 or Instr(str,chr(255))>0 or Instr(str,":") or instr(str,"|")>0 or instr(str,"#")>0 or instr(str,"`")>0 or instr(str,"\")>0 or instr(str,"(")>0 or instr(str,"[")>0 or instr(str,"-")>0 or instr(str,"~") then checkname=false end if end function %>