⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 function.asp

📁 . 缓存处理技术
💻 ASP
📖 第 1 页 / 共 3 页
字号:
	else
	   TempBBRIDCard=""
	end if
	if Cnbbr_UserDegrade="身份证" then
	   TempUserIdCard="<img src="""& TempBBRIDCard &"skins/"& Skins_Folder &"/shenfenzheng.gif"" width=""34"" height=""20"" border=""0"" alt=""已进行真实身份认证"">"
	else
	   TempUserIdCard="<img src="""& TempBBRIDCard &"skins/"& Skins_Folder &"/shenfenzheng_no.gif"" border=""0"" alt=""未进行真实身份认证"">"
	end if
	Disp_UserIDCard=TempUserIdCard
End Function


Dim HelpTitle,HelpInfo,HelpList
Function Cnbbr_Helper(HelpTitle,HelpInfo,Helplist,Helpwidth)
	Response.Write "<title>"& SYS_WEBNAME &"</title>"& Vbcrlf
	Response.Write "<BR><BR>" & Vbcrlf

	Response.Write "<table width="& HelpWidth &" cellpadding=0 cellspacing=0 border=0 align=center>" & Vbcrlf
	Response.Write "  <tr>" & Vbcrlf
	Response.Write "   <td align=center>" & Vbcrlf

	Response.Write "<TABLE cellSpacing=0 cellPadding=0 width=98% align=center border=0 style=""border: 1PX #FF7B2F solid;"">" & Vbcrlf
	Response.Write "<TR>" & Vbcrlf
	Response.Write "<td colspan=3 width=100% height=2 align=center> </td>" & Vbcrlf
	Response.Write "</TR>" & Vbcrlf
	Response.Write "<TR>" & Vbcrlf
	Response.Write "<td colspan=3 width=100% height=23 align=Left border=""0"" style=""Background: #FF7B2F"">"& Vbcrlf
	Response.Write " <span style=""Font-Size: 9pt; Color: #FFFFFF"">>〗<b>"& HelpTitle &"</b></span>" & Vbcrlf
	Response.Write "</td>" & Vbcrlf
	Response.Write "</TR>" & Vbcrlf
	Response.Write "<TR height=1>" & Vbcrlf
	Response.Write "<td width=10% align=center></td><td width=80% align=center> </td><td width=10% align=center></td>" & Vbcrlf
	Response.Write "</TR>" & Vbcrlf
	Response.Write "<TR>" & Vbcrlf
	Response.Write "<td colspan=3 width=100% align=Left class=td>" & Vbcrlf
	Response.Write "<span style=""Font-Size: 9pt; Line-height: 26px;""> &nbsp; &nbsp; "& HelpInfo &"</Span>" & Vbcrlf
	Response.Write "</td>" & Vbcrlf
	Response.Write "</TR>" & Vbcrlf
	Response.Write "<TR height=1>" & Vbcrlf
	Response.Write "<td width=10% align=center></td><td width=80% align=center class=menutdbg_2> </td><td width=10% align=center></td>" & Vbcrlf
	Response.Write "</TR>" & Vbcr
	Response.Write "<TR>" & Vbcrlf
	Response.Write "<td colspan=3 width=100% align=Left class=td>" & Vbcrlf
	Response.Write "<Span style=""Font-Size: 9pt; Line-height: 20px;"">"& HelpList &"</Span>" & Vbcrlf
	Response.Write "</td>" & Vbcrlf
	Response.Write "</TR>" & Vbcrlf
	Response.Write "</Table>" & Vbcrlf

	Response.Write "   </td>" & Vbcrlf
	Response.Write "  </tr>" & Vbcrlf
	Response.Write "</table>" & Vbcrlf
	Response.Write "<BR><BR>"& Vbcrlf

End Function


Function CnbbrSiteMenu(Menu_Width,Menu_Left,Menu_Right)
  Dim LeftTemp,RightTemp,Sitei,Sitej,StrTemp,StrTemp2
  Dim SiteMenuStr
  if Menu_Left<>"" then
     Menu_Left=Split(Menu_left,"||[menu]||")
     For Sitei=0 to Ubound(Menu_Left)
       StrTemp=Menu_Left(Sitei)
       if StrTemp<>"" then
	  StrTemp=Split(StrTemp,"|[menu]|")
	  if IsArray(StrTemp) then StrTemp2=StrTemp2 &" &gt;&gt; <a href="""& StrTemp(0) &""" class=MenuColor_1>"& StrTemp(1) &"</a>"
       End if
     Next
  end if
  LeftTemp=StrTemp2
  Sitei=0:Sitej=0:StrTemp="":StrTemp2=""
  if Menu_Right<>"" then
     Menu_Right=Split(Menu_Right,"||[menu]||")
     For Sitei=0 to Ubound(Menu_Right)
       StrTemp=Menu_Right(Sitei)
       if StrTemp<>"" then
	  StrTemp=Split(StrTemp,"|[menu]|")
	  if IsArray(StrTemp) then StrTemp2=StrTemp2 &" <a href="""& StrTemp(0) &""" class=MenuColor_1>"& StrTemp(1) &"</a>"
       End if
     Next
  end if
  RightTemp=StrTemp2

  SiteMenuStr=SiteMenuStr &"<TABLE cellSpacing=0 cellPadding=0 width="& Menu_Width &" align=center border=0>" & Vbcrlf
  SiteMenuStr=SiteMenuStr &" <TR>" & Vbcrlf
  SiteMenuStr=SiteMenuStr &"  <td colspan=3 width=82% height=32 align=Left border=""0"">"& Vbcrlf
  SiteMenuStr=SiteMenuStr &"   <img src=""skins/"& SKINS_FOLDER &"/Go.gif"" border=""0"">"
  SiteMenuStr=SiteMenuStr &"   您的位置:<a href=""Index.asp"" class=menuColor_1>首页</a>"& LeftTemp & Vbcrlf
  SiteMenuStr=SiteMenuStr &"  </td>" & Vbcrlf
  SiteMenuStr=SiteMenuStr &"  <td width=18% height=23 align=right border=""0"">"& Vbcrlf
  if RightTemp<>"" then SiteMenuStr=SiteMenuStr &"<img src=""skins/"& SKINS_FOLDER &"/Ring.gif"" border=""0"">"& RightTemp & Vbcrlf
  SiteMenuStr=SiteMenuStr &"  </td>" & Vbcrlf
  SiteMenuStr=SiteMenuStr &" </TR>" & Vbcrlf
  SiteMenuStr=SiteMenuStr &" <TR>" & Vbcrlf
  SiteMenuStr=SiteMenuStr &"  <td colspan=4 width=100% height=2 align=center class=menutdbg_1> </td>" & Vbcrlf
  SiteMenuStr=SiteMenuStr &" </TR>" & Vbcrlf
  SiteMenuStr=SiteMenuStr &"</Table>" & Vbcrlf

  CnbbrSiteMenu=SiteMenuStr
End Function


Function CnbbrSqlUser(SqlUserID,SqlFlag)
  Dim RsSqlUser_Name,SqlUserNameStr
  Sql="Select RegUsername from Users Where RegID="& SqlUserID
  Set RsSqlUser_Name=Conn.execute(Sql)
  if RsSqlUser_Name.Eof or RsSqlUser_Name.Bof then
     SqlUserNameStr="无"
  else
     SqlUserNameStr="<a href=""DisplayUser.asp?uID="& SqlUserID &""">"& RsSqlUser_Name("RegUserName") &"</a>"
  end if
  RsSqlUser_Name.Close
  Set RsSqlUser_Name=nothing
  CnbbrSqlUser=SqlUserNameStr
End Function


Function CnBBR_AucClass_Amount(ClassID,Flag)
  if isNum(Flag) then
     if Clng(Flag)=1 then
        sql="update aucclass set aucAmount=aucAmount+1 where classid in ("&ClassID&")"
	conn.execute(sql)
     elseif Clng(Flag)=0 then
        sql="update aucclass set aucAmount=aucAmount-1 where classid in ("&ClassID&")"
	conn.execute(sql)
     else
	Sql=""
     end if
  end if
End Function





Function Disp_AucImages(AucID,BBrFlag)
   Dim rs_img,img_url,ImageStr,tempFontUrl
   sql="select top 1 * from aucimages where aucid="& Aucid &" order by img_order ASC"
   set rs_img=conn.execute(sql)
   if rs_img.bof or rs_img.eof then
      img_url="skins/"& Skins_Folder &"/nopic.gif"
   else
      img_url=RePlace(rs_img("img_url"),"\","/")
   end if
   rs_img.close
   set rs_img=nothing
   
   if Clng(BBrFlag)=1 then 
      Img_Url="../"& Img_Url
      tempFontUrl="../"
   end if
   ImageStr=ImageStr &"<a href="""& tempFontUrl &"aucinfo.asp?aucid="& AucID &""">"
   ImageStr=ImageStr &"<img src="& img_url &" border=""0"" width=""72"" height=""72"" alt="""">"
   ImageStr=ImageStr &"</a>"
   Disp_AucImages=ImageStr
End Function

Function Read_BBRAucImages(AucID,BBRFlag)
   Dim rs_img,img_url
   sql="select top 1 * from aucimages where aucid="& Aucid &" order by img_order ASC"
   set rs_img=conn.execute(sql)
   if rs_img.bof or rs_img.eof then
      img_url="skins\"& Skins_Folder &"\nopic.gif"
   else
      img_url=RePlace(rs_img("img_url"),"/","\")
   end if
   rs_img.close
   set rs_img=nothing
   if BBRFlag=1 then Img_Url="../"&Img_Url
   Read_BBRAucImages=Img_Url
End Function

Function BBRAucSmallImage(ByVal AucID,ByVal DispType,ByVal BBRFlag,ByVal NotImgPath)

    Dim TempStr,TempFont
    if BBRFlag=1 then
       TempFont="../"
    else
       TempFont=""
    end if
    TempStr="<a href="""& TempFont &"AucInfo.asp?aucid="& AucID &""">" & vbcrlf
       Select Case DispType
        Case 0:
	  TempStr=TempStr & PixelPic(72,72,Read_BBRAucImages(AucID,BBRFlag),NotImgPath)
	Case 1: 
	  TempStr=TempStr &"<img src="""& TempFont &"Skins/"& SKINS_FOLDER &"/ReplacePic.gif"" border=""0"" alt="""">"& Vbcrlf
	Case else:
       End Select
    TempStr=TempStr &"</a>" & vbcrlf
    BBRAucSmallImage=TempStr
End Function


Function CnbbrLink(LinkOwner,LinkFlag)

  Dim Templink,RsLink
  TempLink=""
  if not isNum(LinkOwner) then Exit Function
  Sql="Select Cnbbr_Lid,Cnbbr_lWebName,Cnbbr_lWebUrl,Cnbbr_lWebLogo,Cnbbr_lDescription,Cnbbr_lisLogo,Cnbbr_lOwnerID from Cnbbr_Link where Cnbbr_lOwnerID="& LinkOwner &" order by Cnbbr_lIsLogo Desc"
  Set RsLink=Conn.execute(Sql)
  if Not RsLink.Eof then
     Do While Not RsLink.Eof
      if LinkFlag=0 then
        TempLink=TempLink &"<a href="""&RsLink("Cnbbr_lWebUrl")&""" title="""& RsLink("Cnbbr_lDescription") &""" target=""_blank"">"& RsLink("Cnbbr_lWebName") &"</a> &nbsp; "& Vbcrlf
      else
        TempLink=TempLink &"<a href="""&RsLink("Cnbbr_lWebUrl")&""" title="""& RsLink("Cnbbr_lDescription") &""" target=""_blank"">"& RsLink("Cnbbr_lWebName") &"</a><BR>"& Vbcrlf
      end if
     RsLink.MoveNext
     Loop
  End if
  RsLink.Close
  Set RsLink=nothing
  CnbbrLink=TempLink

End Function


  Function Cnbbr_FiltrateIP()

 
	Dim User_Ip
	User_Ip=Request.servervariables("REMOTE_ADDR")
	Dim IpArray,WhyIpLock
	IpArray=split(User_Ip,".")
	Dim IpSQL,IpRS
	IpSQL="SELECT iplock From Cnbbr_IpLock Where  "& _
	" (ipsame=4 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" and ip3="&Cint(IpArray(2))&" and ip4="&Cint(IpArray(3))&" )  "& _
	" Or (ipsame=3 and  ip1="&Cint(IpArray(0))&"  and  ip2="&Cint(IpArray(1))&"  and  ip3="&Cint(IpArray(2))&" )   "& _
	" Or (ipsame=2 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" )   "& _
	" Or (ipsame=1 and ip1="&Cint(IpArray(0))&" ) Order By ipid "
	Set IpRS=Conn.execute(IpSQL)
	If Not (IpRS.bof or IpRS.eof) Then
	WhyIpLock=split(IpRS("iplock"),"|")
		Response.Write"<Html>" & Vbcrlf
		Response.Write"<Head><Title>"& SYS_WEBNAME &"</Title>" & Vbcrlf
		Response.Write"<Link rel=stylesheet type=text/css href=SKINS/"& SKINS_FOLDER &"/css.css>" & Vbcrlf
		Response.Write"</Head>" & Vbcrlf
		Response.Write"<Body TopMargin=0 LeftMargin=0>" & Vbcrlf
		Response.Write"<BR><BR><BR><BR><BR><BR>" & vbcrlf
		Response.Write"<table cellpadding=0 cellspacing=1 width=320 border=0 align=center class=tablebg>" & Vbcrlf
		Response.Write"<tr>" & Vbcrlf
		Response.Write"<td align=center class=titletd><b>欢迎你访问"& SYS_WEBNAME &"!</b></td>" & Vbcrlf
		Response.Write"</tr>" & Vbcrlf
		Response.Write"<tr class=td>" & Vbcrlf
		Response.Write"<td align=left>" & Vbcrlf
		Response.Write"<BR><ol>你使用的IP段或IP地址已被封锁,具体情况如下:<br><br>"
		Response.Write"<Li>封锁原因:"&WhyIpLock(1)
		Response.Write"<LI>封锁时间:"&WhyIpLock(0)
		Response.Write"<LI>你可以通过邮件与<a href=mailto:"& SYS_WEBEMAIL &"> 管理员 </a>联系</ol>"
		Response.Write"</td>" & Vbcrlf
		Response.Write"</tr>" & Vbcrlf
		Response.Write"</table>" & Vbcrlf
		Response.Write"</Body>" & Vbcrlf
		Response.Write"</Html>" & Vbcrlf
		Response.End
	End If
	Set IpRS=Nothing

  End Function



Function SysCount(ByVal sType,ByVal sAmount)
  On Error Resume Next
  select Case sType
    	Case 1: 
	  Sql="Update syscount Set BBRUserCount=BBRUserCount+"& sAmount
    	Case 2: 
	  Sql="Update syscount Set BBRAucCount=BBRAucCount+"& sAmount
    	Case 3: 
	  Sql="Update syscount Set BBRShopCount=BBRShopCount+"& sAmount
    	Case 4: 
	  Sql="Update syscount Set BBROverCount=BBROverCount+"& sAmount
    	Case 5: 
	  Sql="Update syscount Set BBRBidOverCount=BBRBidOverCount+"& sAmount
    	Case 6: 
	  Sql="Update syscount Set BBRYkjOverCount=BBRYkjOverCount+"& sAmount
	Case else: Sql=""
  end select
  Conn.execute(Sql)
  if Err then
     SysCount=False
  else
     SysCount=True
  end if
  On Error GoTo 0    
End Function


Function ClassAucCount(ByVal sClassPath,ByVal sAmount)
  On Error Resume Next
  sClassPath=Replace(sClassPath,"|",",")
  Sql="Update AucClass Set AucAmount=AucAmount+"& sAmount &" where classid in ("& sClassPath &")"
  Conn.execute(Sql)
  if Err then
     ClassAucCount=False
  else
     ClassAucCount=True
  end if
  On Error GoTo 0
End Function


Function UserAucCount(ByVal sUserID,ByVal sAmount)
  On Error Resume Next
  Sql="Update Users Set TotalAucAmount=TotalAucAmount+"& sAmount &",SellingAucAmount=SellingAucAmount+"& sAmount &" where Regid="& sUserID
  Conn.execute(Sql)
  if Err then
     UserAucCount=False
  else
     UserAucCount=True
  end if
  On Error GoTo 0
End Function


Function AucOldNew(ByVal TempVal,ByVal Flag)
  	Dim TempOldNew,TempStr
	OldNewStr=Replace(OldNewStr,",",",")
	TempOldNew=Split(OldNewStr,",")
	if Ubound(TempOldNew)>0 then
	   for i=0 to ubound(TempOldNew)
	     if Flag=1 then
	    	TempStr=TempStr &"<option value="& i+1 
	    	if i=TempVal-1 then TempStr=TempStr & " Selected"
	    	TempStr=TempStr &">"& TempOldNew(i) &"</option>"& Vbcrlf
	     else
		if i=TempVal-1 then TempStr=TempOldNew(i)
	     end if
	   next
	end if
	AucOldNew=TempStr
End Function


Function InfoClass(ByVal TempVal,ByVal Flag)
  	Dim TempInfoClass,TempStr
	InfoClassStr=Replace(InfoClassStr,",",",")
	TempInfoClass=Split(InfoClassStr,",")
	if Ubound(TempInfoClass)>0 then
	   for i=0 to ubound(TempInfoClass)
	     if Flag=1 then
	    	TempStr=TempStr &"<option value="& i+1 
	    	if i=TempVal-1 then TempStr=TempStr & " Selected"
	    	TempStr=TempStr &">"& TempInfoClass(i) &"</option>"& Vbcrlf
	     else
		if i=TempVal-1 then TempStr=TempInfoClass(i)
	     end if
	   next
	end if
	InfoClass=TempStr
End Function



Function AucPayStyle(ByVal TempVal,ByVal Flag)
  	Dim TempS,TempStr
	PayStyleStr=Replace(PayStyleStr,",",",")
	TempS=Split(PayStyleStr,",")
	if Ubound(TempS)>0 then
	   for i=0 to ubound(TempS)
	     if Flag=1 then
	    	TempStr=TempStr &"<option value="& i+1 
	    	if i=TempVal-1 then TempStr=TempStr & " Selected"
	    	TempStr=TempStr &">"& TempS(i) &"</option>"& Vbcrlf
	     else
		if i=TempVal-1 then TempStr=TempS(i)
	     end if
	   next
	end if
	AucPayStyle=TempStr
End Function



Function PayForTM(ByVal TempVal,ByVal Flag)
  	Dim TempS,TempStr
	PayForTMStr=Replace(PayForTMStr,",",",")
	TempS=Split(PayForTMStr,",")
	if Ubound(TempS)>0 then
	   for i=0 to ubound(TempS)
	     if Flag=1 then
	    	TempStr=TempStr &"<option value="& i+1 
	    	if i=TempVal-1 then TempStr=TempStr & " Selected"
	    	TempStr=TempStr &">"& TempS(i) &"</option>"& Vbcrlf
	     else
		if i=TempVal-1 then TempStr=TempS(i)
	     end if
	   next
	end if
	PayForTM=TempStr
End Function
%>

⌨️ 快捷键说明

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