function.asp

. 缓存处理技术

<!--#include file="safe.asp"-->
<%


Dim cnbbr_CurrentHost,cnbbr_CurrentPath,cnbbr_ComeUrl
cnbbr_CurrentHost=Cstr(Request.ServerVariables("SERVER_NAME"))
cnbbr_CurrentPath=Cstr(Request.ServerVariables("PATH_INFO"))
cnbbr_ComeUrl=Cstr(Request.ServerVariables("HTTP_REFERER"))
if cnbbr_ComeUrl<>"" then
    if InStr(cnbbr_ComeUrl,"PreAucBid.asp")>0 then Cnbbr_ComeUrl=Replace(Cnbbr_ComeUrl,"PreAucBid.asp","AucInfo.asp")
end if
Dim cnBBR_CurFilePath
cnBBR_CurFilePath=Cnbbr_CurrentHost & Cnbbr_CurrentPath
cnBBR_CurFilePath=Left(cnBBR_CurFilePath,Len(cnBBR_CurFilePath)-Instr(cnBBR_CurFilePath,"/"))
cnBBR_CurFilePath="Http://"& cnBBR_CurFilePath

Function Cnbbr_CheckPost(pType)
  If Mid(cnbbr_ComeUrl,8,len(cnbbr_CurrentHost))<>cnbbr_CurrentHost Then
   if pType=1 then
      With Response
	.Write "<TABLE cellSpacing=0 cellPadding=0 width="""& SYS_BodyWidth &""" align=center border=0>" & Vbcrlf
	.Write "<TR>" & Vbcrlf
	.Write "<td colspan=3 width=100% height=2 align=center class=menutdbg_1> </td>" & Vbcrlf
	.Write "</TR>" & Vbcrlf
	.Write "<TR>" & Vbcrlf
	.Write "<td colspan=3 width=100% height=23 align=Left background=""SKINS/"& SKINS_FOLDER &"/GrayBg.Gif"" border=""0"">"& Vbcrlf
	.Write " <img src=""skins/"& SKINS_FOLDER &"/Go.gif"" border=""0"" alt="""">"
	.Write " <span Class=menufont_1><b>您的位置：<a href=""index.asp"" Class=""menuColor_1"">首页</a>&nbsp;&gt;&nbsp;信息小贴士</b></span>" & Vbcrlf
	.Write "</td>" & Vbcrlf
	.Write "</TR>" & Vbcrlf
	.Write "<TR height=1>" & Vbcrlf
	.Write "<td width=10% align=center></td><td width=80% align=center class=menutdbg_2> </td><td width=10% align=center></td>" & Vbcrlf
	.Write "</TR>" & Vbcrlf
	.Write "</Table>" & Vbcrlf
      End With
      HelpTitle="出错了！"
      HelpInfo="对不起，你的来源位置非法，请从站内提交当前操作！"
      HelpList="<Ul>" & Vbcrlf
      HelpList=HelpList & "<LI><a href=""index.asp"">登陆首页</a></LI>" & Vbcrlf
      HelpList=HelpList & "<LI><a href=""javascript: history.back(-1);"">返回上页</a></LI>" & Vbcrlf
      HelpList=HelpList & "</Ul>" & Vbcrlf
      Cnbbr_Helper HelpTitle,HelpInfo,HelpList,368
      Cnbbr_Bottom
      Response.End
   else
      Call AlertInfo("当前地址来源非法，请从系统首页进入后再进行当前操作！","index.asp",1)
   end if
  end if
End Function










Function AlertInfo(Alert_Info,aNextPage,aType)
  aType=cint(aType)
  Select Case aType
    Case 0:
	Response.Write"<script language='javascript'>alert('"& Alert_Info &"');history.back(-1);</script>"
  	Response.End
    Case 1:
	Response.Write"<script language='javascript'>alert('"& Alert_Info &"');this.location.href='"& aNextPage &"';</script>"
  	Response.End
    Case else:
	Response.Write"<script language='javascript'>alert('"& Alert_Info &"');history.back(-1);</script>"
  	Response.End
  End Select
End Function


Function Rst( psvaluename )
  dim stemp
  stemp = Trim(request.querystring("" & psvaluename))
  if len(trim(stemp)) = 0 then
     stemp = Trim(request.form("" & psvaluename))
  end if
  rst = stemp
End Function



Function IsNum(stri)
  IsNum=True
  if stri="" or isNull(stri) then
     IsNum=False
  else
   Stri=Replace(Stri,",","")
   For i=1 to len(stri)
    if isNumeric(mid(stri,i,1)) or mid(stri,i,1)="." then 
  	IsNum=True
    else
	IsNum=False
	Exit For
    end if
   Next
  end if
End Function

Function HTMLEncode(reString) '转换HTML代码
	Dim Str:Str=reString
	If Not IsNull(Str) Then
		Str = UnCheckStr(Str)
		Str = Replace(Str, "&", "&amp;")
		Str = Replace(Str, ">", "&gt;")
		Str = Replace(Str, "<", "&lt;")
		Str = Replace(Str, CHR(32), "&nbsp;")
		Str = Replace(Str, CHR(9), "&nbsp;&nbsp;&nbsp;&nbsp;")
		Str = Replace(Str, CHR(9), "&#160;&#160;&#160;&#160;")
		Str = Replace(Str, CHR(34),"&quot;")
		Str = Replace(Str, CHR(39),"&#39;")
		Str = Replace(Str, CHR(13), "")
		Str = Replace(Str, CHR(10), "<br>")
		HTMLEncode = Str
	End If
End Function

Function ReHTMLEncode(reString) '转换HTML代码
	Dim Str:Str=reString
	If Not IsNull(Str) Then
		Str = CheckStr(Str)
		Str = Replace(Str, "&amp;" ,"&")
		Str = Replace(Str, "&gt;", ">")
		Str = Replace(Str, "&lt;", "<")
		Str = Replace(Str, "&nbsp;", CHR(32))
		Str = Replace(Str, "&nbsp;&nbsp;&nbsp;&nbsp;", CHR(9))
		Str = Replace(Str, "&#160;&#160;&#160;&#160;", CHR(9))
		Str = Replace(Str, "&quot;", CHR(34))
		Str = Replace(Str, "&#39;", CHR(39))
		Str = Replace(Str, "", CHR(13))
		Str = Replace(Str, "<br>", CHR(10))
		ReHTMLEncode = Str
	End If
End Function

Function CheckStr(byVal ChkStr) '检查无效字符
	Dim Str:Str=ChkStr
	Str=Trim(Str)
	If IsNull(Str) Then
		CheckStr = ""
		Exit Function 
	End If
	Dim re
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	re.Pattern="(\r\n){3,}"
	Str=re.Replace(Str,"$1$1$1")
	Set re=Nothing
	Str = Replace(Str,"'","''")
	Str = Replace(Str, "select", "sel&#101;ct")
	Str = Replace(Str, "join", "jo&#105;n")
	Str = Replace(Str, "union", "un&#105;on")
	Str = Replace(Str, "where", "wh&#101;re")
	Str = Replace(Str, "insert", "ins&#101;rt")
	Str = Replace(Str, "delete", "del&#101;te")
	Str = Replace(Str, "update", "up&#100;ate")
	Str = Replace(Str, "like", "lik&#101;")
	Str = Replace(Str, "drop", "dro&#112;")
	Str = Replace(Str, "create", "cr&#101;ate")
	Str = Replace(Str, "modify", "mod&#105;fy")
	Str = Replace(Str, "rename", "ren&#097;me")
	Str = Replace(Str, "alter", "alt&#101;r")
	Str = Replace(Str, "cast", "ca&#115;t")



	Dim Sys_Str_words2
	Sys_Str_Words2=Split(Sys_Str_Words,"|")
	For i=0 to Ubound(Sys_Str_Words2)
	  Str=Replace(Str,Sys_Str_Words2(i),"^_^")
	Next


	CheckStr=Str
End Function

Function UnCheckStr(Str)
		Str = Replace(Str, "sel&#101;ct", "select")
		Str = Replace(Str, "jo&#105;n", "join")
		Str = Replace(Str, "un&#105;on", "union")
		Str = Replace(Str, "wh&#101;re", "where")
		Str = Replace(Str, "ins&#101;rt", "insert")
		Str = Replace(Str, "del&#101;te", "delete")
		Str = Replace(Str, "up&#100;ate", "update")
		Str = Replace(Str, "lik&#101;", "like")
		Str = Replace(Str, "dro&#112;", "drop")
		Str = Replace(Str, "cr&#101;ate", "create")
		Str = Replace(Str, "mod&#105;fy", "modify")
		Str = Replace(Str, "ren&#097;me", "rename")
		Str = Replace(Str, "alt&#101;r", "alter")
		Str = Replace(Str, "ca&#115;t", "cast")
		UnCheckStr=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 InterceptString(txt,length)
	dim x,y,ii
	txt=trim(txt)
	x = len(txt)
	y = 0
	if x >= 1 then
		for ii = 1 to x
			if asc(mid(txt,ii,1)) < 0 or asc(mid(txt,ii,1)) >255 then '如果是汉字
				y = y + 2
			else
				y = y + 1
			end if
			if clng(y)>=clng(length) then
				txt = left(trim(txt),ii) '字符串限长
				InterceptString = txt & ".."
				exit for
			else
				InterceptString = txt
			end if
		next
		
	else
		InterceptString = ""
	end if
End Function








Function SelectOper(select_str0,select_str1,select_str2)













  select_str1=Replace(select_str1,"，",",")
  select_str2=Replace(select_str2,"，",",")

  select_str1=split(select_str1,",")
  select_str2=split(select_str2,",")

  if Ubound(select_str1)<>Ubound(select_str2) then
     Response.Write "<option value="""">出错了，Option个数不等！</option>"
  else
     For i=0 to Ubound(select_str1)
	 Response.Write "<option value="& select_str1(i) &""
	 if Cstr(select_str0)=Cstr(select_str1(i)) then Response.Write " selected"
	 Response.Write ">"& select_str2(i) &"</option>"& vbcrlf
     Next 
  end if  
End Function









Function RadioOper(radio_str0,radio_str1,radio_str2,radio_name)












  radio_str1=Replace(radio_str1,"，",",")
  radio_str2=Replace(radio_str2,"，",",")

  radio_str1=split(radio_str1,",")
  radio_str2=split(radio_str2,",")
  if Ubound(radio_str1)<>Ubound(radio_str2) then
     Response.Write "<option value="""">出错了，Option个数不等！</option>"
  else
     For i=0 to Ubound(radio_str1)
	 response.write"<input name="& radio_name &" type=radio value="& radio_str1(i) &""
	 if Cstr(radio_str0)=Cstr(radio_str1(i)) then response.write " checked"
	 response.write">"& radio_str2(i) &" "
     Next     
  end if
End Function








Function BoxOper(Box_str0,Box_str1,Box_str2,Box_name)












  Box_str0=Replace(Box_str0,"，",",")
  Box_str1=Replace(Box_str1,"，",",")
  Box_str2=Replace(Box_str2,"，",",")

  Box_str1=split(Box_str1,",")
  Box_str2=split(Box_str2,",")
  if Ubound(Box_str1)<>Ubound(Box_str2) then
     Response.Write "<option value="""">出错了，Option个数不等！</option>"
  else
     For i=0 to Ubound(Box_str1)
	 response.write"<input name="& Box_name &" type=CheckBox value="& Box_str1(i) &""
	 Dim TempStr0:TempStr0=Cstr(Box_str0)
	 Dim TempStr0i:TempStr0i=0
	 TempStr0=Split(TempStr0,",")
	 For TempStr0i=0 to Ubound(TempStr0)
	     if Cstr(TempStr0(TempStr0i))=Cstr(Box_str1(i)) then response.write " checked"
         next
	 response.write">"& Box_str2(i) &" "
     Next     
  end if
End Function







Function TransParam()
  Dim sq,sf,skey,i,temp,tempkey
  sq=request.querystring()
  sf=request.form()
  skey=sq&sf
  if skey<>"" then
   if sq="" then
   	skey=sq
   elseif sf="" then
	skey=sq
   else
	skey=sq&"&"&sf
   end if
   skey=split(skey,"&")
   For i=0 to Ubound(skey)
	tempkey=split(skey(i),"=")