📄 format.asp

📁 后台登陆admin.asp
💻 ASP
字号:
<%
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+"&nbsp;&nbsp;&nbsp;[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,"&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

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<img align=absmiddle src=img/url.gif border=0><a target=_blank href=$2>$2</a>")
url.Pattern = "((http|https|ftp|rtsp|mms|pnm|mmst):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)$"
str = url.Replace(str,"<img align=absmiddle src=img/url.gif border=0><a target=_blank href=$1>$1</a>")
url.Pattern = "([^>=""])((http|https|ftp|rtsp|mms|pnm|mmst):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)"
str = url.Replace(str,"$1<img align=absmiddle src=img/url.gif border=0><a target=_blank href=$2>$2</a>")
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<img align=absmiddle src=img/url.gif border=0><a target=_blank href=http://$2>$2</a>")
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)
	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)<Page And (ToPage-FromPage)<Pages Then ToPage=Page
			ElseIF Topage>Pages Then
				FromPage =Curpage-Pages +ToPage
				ToPage=Pages
				If (ToPage-FromPage)<Page And (ToPage-FromPage)<Pages Then FromPage=Pages-Page+1
			End If
		End If
                MultiPage="<a href="""&Url&"page=1""><IMG src='img/lt.gif' align=""absMiddle"" border=""0"">首页</a> "
		If Curpage>1 Then 
                        MultiPage=MultiPage&"<a href="""&Url&"page="&Curpage-1&""">上一页</a> "
                Else
                        MultiPage=MultiPage&"上一页 "
                End If
		For PageI=FromPage TO ToPage
			If PageI<>CurPage Then
				MultiPage=MultiPage&"<a href="""&Url&"page="&PageI&""">"&PageI&"</a> "
			Else
				MultiPage=MultiPage&"<font color=red><b>"&PageI&"</b></font> "
			End If
		Next
		If Curpage<Pages Then 
                        MultiPage=MultiPage&"<a href="""&Url&"page="&Curpage+1&""">下一页</a> "
                Else
                        MultiPage=MultiPage&"下一页 "
                End If
		        MultiPage=MultiPage&"<a href="""&Url&"page="&Pages&""">尾页<IMG src='img/rt.gif' align=""absMiddle"" border=""0""></a>"
	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("<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0' width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&"><param name='movie' value="&ADRS("Ad_Pic")&"><param name='wmode' value='transparent'><embed src="&ADRS("Ad_Pic")&" quality='high' pluginspage='http://www.macromedia.com/go/getflashplayer' type='application/x-shockwave-flash' width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&"></embed></object>")
    else
    if ADRS("AD_http")="" then
    Response.Write("<div>")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0"" alt="&ADRS("AD_Alt")&"></div>")
    else
    if ADRS("blank")=true then
    Response.Write("<div><a target='_blank' href="&ADRS("Ad_Http")&">")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0"" alt="&ADRS("AD_Alt")&"></a></div>")
    else
    Response.Write("<div><a href="&ADRS("Ad_Http")&">")
    Response.Write("<img src="&ADRS("Ad_Pic")&" width="&ADRS("Ad_width")&" height="&ADRS("Ad_height")&" border=""0"" alt="&ADRS("AD_Alt")&"></a></div>")
    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), "&nbsp;")
  String = Replace(String, " ", "&nbsp;")
  String = Replace(String, "<", "&lt;")
  String = Replace(String, ">", "&gt;")
  String = Replace(String, CHR(10) & CHR(10), "<BR><BR>")
  String = Replace(String, CHR(10), "<BR>")
  FormatStr = String
End Function

Function CODEStr(String)
  on Error resume next
  String = Replace(String, "&", "&#38;")
  String = Replace(String, "R", "&#82;")
  String = Replace(String, "r", "&#114;")
  String = Replace(String, "&amp;", "&#38;&#97;&#109;&#112;&#59;")
  String = Replace(String, "&quot;", "&#38;&#113;&#117;&#111;&#116;&#59;")
  String = Replace(String, "&lt;", "&#38;&#108;&#116;&#59;")
  String = Replace(String, "&gt;", "&#38;&#103;&#116;&#59;")
  String = Replace(String, "&nbsp;", "&#38;&#110;&#98;&#115;&#112;&#59;")
  String = Replace(String, "<", "&lt;")
  String = Replace(String, ">", "&gt;")
  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,"?")<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

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

function HTMLEncode(fString)
if not isnull(fString) then
    fString = replace(fString, ">", "&gt;")
    fString = replace(fString, "<", "&lt;")
    fString = Replace(fString, CHR(32), "&nbsp;")
    fString = Replace(fString, CHR(9), "&nbsp;")
    fString = Replace(fString, CHR(34), "&quot;")
    fString = Replace(fString, CHR(39), "&#39;")
    fString = Replace(fString, CHR(13), "")
    fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
    fString = Replace(fString, CHR(10), "<BR> ")
    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"<center>非法操作导致程序中止!</center>"
			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,"&","&amp;")
	Str = replace(Str,chr(34),"&quot;")
        Str = Replace(Str, ">", "&gt;")
        Str = Replace(Str, "<", "&lt;")
    	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,"
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -